├── CategoryModel ├── Basics.agda ├── MorphUtils.agda ├── PiTypes.agda └── SigmaTypes.agda ├── CategoryTheory.agda ├── GroupoidModel ├── Basics.agda ├── Groupoid.agda ├── IdTypes.agda ├── Model.agda ├── PiTypes.agda └── Universe.agda ├── Model.agda ├── PShModel.agda ├── README.md ├── StandardModel.agda ├── Syntax.agda └── Utils.agda /CategoryModel/Basics.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --allow-unsolved-metas #-} 2 | 3 | module CategoryModel.Basics {l} where 4 | 5 | open import Function using (_$_) 6 | open import Cubical.Core.Prelude 7 | open import CategoryTheory 8 | open import Utils 9 | open import Agda.Primitive 10 | open import CategoryModel.MorphUtils 11 | 12 | -- we work exclusively with strict categories everywhere 13 | postulate 14 | strct : (C : Category {l} {l}) -> isStrictCategory C 15 | 16 | open CatCategory strct 17 | open TyUtils strct 18 | 19 | Ty : Category {l} {l} -> Set (lsuc l) 20 | Ty Γ = Γ ⟶ Cat 21 | 22 | ty-op : {Γ : Category} -> Ty Γ -> Ty Γ 23 | ty-op A = compFun A op-functor 24 | 25 | module _ {Γ : Category {l} {l}} (A : Ty Γ) where 26 | 27 | open Category 28 | open Functor 29 | 30 | -- overFid-commute : ∀{γ γ'} {x : _} (p : Morph Γ γ γ') 31 | -- -> (((A ₁) p ₁) (overFid (id ((A ₀) γ) x))) 32 | -- ≡ MU.substMorph ((A ₀) γ') 33 | -- (sym {!!}) (id ((A ₀) γ') ((A ₁) p ₀ $ x)) 34 | -- overFid-commute p = {!!} 35 | 36 | -- overFid-lemma : ∀{γ γ'} {x : _} {x' : _} 37 | -- -> (p : Morph Γ γ γ') (q : Morph ((A ₀) γ') (((A ₁) p ₀) x) x') 38 | -- -> _∘_ ((A ₀) γ') (overFidL A (id ((A ₀) γ') x')) ((((A ₁) (id Γ _)) ₁) q) ≡ overFidL A q 39 | -- overFid-lemma {γ} {γ'} {x} {x'} p q = begin 40 | -- _ 41 | -- ≡⟨ ap (λ z → _∘_ ((A ₀) γ') (overFidL A (id ((A ₀) γ') x')) z) (IdFun-lemma {Γ} A q) ⟩ 42 | -- _∘_ ((A ₀) γ') (overFidL A (id ((A ₀) γ') x')) (MU.substMorph2 ((A ₀) γ') (sym (fid-prf A _)) (sym (fid-prf A x')) q) 43 | -- ≡⟨ MU.substMorph2∘ ((A ₀) γ') (sym (fid-prf A _)) (sym (fid-prf A x')) q (id ((A ₀) γ') x') ⟩ 44 | -- overFidL A (_∘_ ((A ₀) γ') (id ((A ₀) γ') x') q) 45 | -- ≡⟨ ap (overFidL A) (id∘ ((A ₀) γ') q) ⟩ 46 | -- overFidL A q 47 | -- ∎ 48 | 49 | open Category 50 | open Functor 51 | 52 | _,,_ : (Γ : Category) -> Ty Γ -> Category {l} {l} 53 | Obj (Γ ,, A) = Σ (Obj Γ) λ γ → Obj ((A ₀) γ) 54 | Morph (Γ ,, A) (γ , x) (γ' , x') = 55 | Σ (Morph Γ γ γ') λ p → Morph ((A ₀) γ') ((((A ₁) p) ₀) x) x' 56 | id (Γ ,, A) (γ , x) = id Γ γ , overFidL A (id ((A ₀) γ) x) 57 | _∘_ (Γ ,, A) {γ , x} {γ' , x'} {γ'' , x''} (p' , q') (p , q) = 58 | _∘_ Γ p' p , _∘_ ((A ₀) γ'') q' (overF∘L A p p' ((((A ₁) p') ₁) q)) 59 | hom-set (Γ ,, A) {b = b} = Σ-set (hom-set Γ) λ x → hom-set ((A ₀) (fst b)) 60 | id∘ (Γ ,, A) {γ , x} {γ' , x'} (p , q) = Σ-≡ (id∘ Γ p , goal) 61 | where 62 | open MU ((A ₀) γ') 63 | sub = substMorph (ap (λ z → ((A ₁) z) ₀ $ x) (id∘ Γ p)) 64 | goal = begin 65 | _ ≡⟨ ap sub (overF∘L-comp A p (id Γ γ') _ _) ⟩ 66 | sub (overF∘L A p (id Γ γ') (_∘_ ((A ₀) γ') (overFidL A (id ((A ₀) γ') x')) (((A ₁) (id Γ γ') ₁) q))) 67 | ≡⟨ {!!} -- ap (λ z → sub (overF∘L A p (id Γ γ') z)) (overFid-lemma {Γ} A p q) 68 | ⟩ 69 | sub (overF∘L A p (id Γ γ') (overFidL A q)) 70 | ≡⟨ joinSM _ _ _ q ⟩ 71 | _ ≡⟨ remove-SM {!!} _ _ ⟩ 72 | _ ∎ 73 | ∘id (Γ ,, A) {γ , x} {γ' , x'} (p , q) = Σ-≡ (∘id Γ p , goal) 74 | where 75 | open MU ((A ₀) γ') 76 | sub = substMorph (ap (λ z → ((A ₁) z) ₀ $ x) (∘id Γ p)) 77 | goal = begin 78 | _ ≡⟨ ap sub (overF∘L-comp A (id Γ γ) p (((A ₁) p ₁) 79 | (overFidL A (id ((A ₀) γ) x))) q) ⟩ 80 | _ ≡⟨ ap (λ z → sub (overF∘L A (id Γ γ) p (_∘_ ((A ₀) γ') q z))) 81 | (fid-SM ((A ₁) p) _) ⟩ 82 | _ ≡⟨ ap (λ z → sub (overF∘L A (id Γ γ) p z)) (substMorph∘ _ _ q) ⟩ 83 | _ ≡⟨ joinSM _ _ _ (_∘_ ((A ₀) γ') q (id (A ₀ $ γ') ((A ₁) p ₀ $ x))) ⟩ 84 | _ ≡⟨ remove-SM {!!} _ _ ⟩ 85 | _ ≡⟨ ∘id ((A ₀) γ') q ⟩ 86 | _ ∎ 87 | ∘∘ (Γ ,, A) = {!!} 88 | 89 | _,,op_ : (Γ : Category) -> Ty (Γ ᵒᵖ) -> Category {l} {l} 90 | Obj (Γ ,,op A) = Σ (Obj Γ) λ γ → Obj ((A ₀) γ) 91 | Morph (Γ ,,op A) (γ , x) (γ' , x') = Σ (Morph Γ γ γ') λ f → Morph ((A ₀) γ) x ((((A ₁) f) ₀) x') 92 | id (Γ ,,op A) (γ , x) = id Γ γ , overFidR A (id ((A ₀) γ) x) 93 | _∘_ (Γ ,,op A) {γ , x} {γ' , x'} {γ'' , x''} (p' , q') (p , q) 94 | = _∘_ Γ p' p , _∘_ ((A ₀) γ) (overF∘R A p' p (((A ₁) p ₁) q')) q 95 | id∘ (Γ ,,op A) (p , q) = Σ-≡ (id∘ Γ p , {!!}) 96 | ∘id (Γ ,,op A) = {!!} 97 | ∘∘ (Γ ,,op A) = {!!} 98 | hom-set (Γ ,,op A) = {!!} 99 | 100 | module _ {Γ : Category} (A : Ty (Γ ᵒᵖ)) {γ γ'} {a a' : Obj ((A ₀) γ')} 101 | (p : Morph Γ γ γ') (q : Morph (A ₀ $ γ') a a') where 102 | 103 | private 104 | p·a = (((A ₁) p) ₀ $ a) 105 | p·a' = (((A ₁) p) ₀ $ a') 106 | p·q = ((A ₁) p) ₁ $ q 107 | 108 | p-id-q-lemma : (_∘_ (Γ ,,op A) (p , id ((A ₀) γ) p·a') (id Γ γ , overFidR A p·q)) 109 | ≡ (p , p·q) 110 | p-id-q-lemma = Σ-≡ (∘id Γ p , goal) 111 | where 112 | sub = MU.substMorphR ((A ₀) γ) (ap (λ f → (f ₀) a') (ap (A ₁) (∘id Γ p))) 113 | goal = begin 114 | _ ≡⟨ ap sub (MU.substMorphR∘ ((A ₀) γ) _ (overFidR A p·q) (((A ₁) (id Γ γ) ₁) (id ((A ₀) γ) p·a'))) ⟩ 115 | _ ≡⟨ ap sub (ap (overF∘R A p (id Γ γ)) (ap (λ z → _∘_ ((A ₀) γ) z (overFidR A p·q)) (IdFun-lemma A _))) ⟩ 116 | _ ≡⟨ ap sub (ap (overF∘R A p (id Γ γ)) (MU.substMorph2∘' ((A ₀) γ) _ _ _ _)) ⟩ 117 | _ ≡⟨ ap sub (ap (overF∘R A p (id Γ γ)) (ap (MU.substMorphR ((A ₀) γ) _) (id∘ ((A ₀) γ) p·q))) ⟩ 118 | _ ≡⟨ MU.joinSMR-3 ((A ₀) γ) _ _ _ p·q ⟩ 119 | _ ≡⟨ MU.remove-SMR ((A ₀) γ) (λ x y → strct ((A ₀) γ)) _ _ ⟩ 120 | _ ∎ 121 | 122 | p-id-q-lemma' : (_∘_ (Γ ,,op A) (id Γ γ' , overFidR A q) (p , (id ((A ₀) γ) p·a))) 123 | ≡ (p , p·q) 124 | p-id-q-lemma' = Σ-≡ (id∘ Γ p , {!!}) 125 | 126 | module _ where 127 | 128 | open Category 129 | open Functor 130 | 131 | record Tm (Γ : Category) (A : Ty Γ) : Set l where 132 | field 133 | _₀' : (γ : Obj Γ) → Obj ((A ₀) γ) 134 | _₁' : ∀{γ γ'} → (p : Morph Γ γ γ') 135 | → Morph ((A ₀) γ') (((A ₁) p ₀) (_₀' γ)) (_₀' γ') 136 | fid' : ∀ γ → _₁' (id Γ γ) ≡ overFidL A (id ((A ₀) γ) (_₀' γ)) 137 | f∘' : ∀{γ γ' γ''} → (p : Morph Γ γ γ') (p' : Morph Γ γ' γ'') 138 | -> _₁' (_∘_ Γ p' p) ≡ overF∘L A p p' (_∘_ ((A ₀) γ'') 139 | (_₁' p') 140 | (((A ₁) p' ₁) (_₁' p))) 141 | 142 | open Tm 143 | 144 | module _ {Γ} {A : Ty Γ} where 145 | 146 | _◂ : Tm Γ A → Γ ⟶ (Γ ,, A) 147 | (M ◂ ₀) γ = γ , (M ₀') γ 148 | (M ◂ ₁) p = p , (M ₁') p 149 | fid (M ◂) x = Σ-≡ (refl , transpRefl _ _ · fid' M x) 150 | f∘ (M ◂) f g = Σ-≡ (refl , (transpRefl _ _ · (f∘' M g f 151 | · sym (overF∘L-comp A _ _ _ _)))) 152 | 153 | record TmMorph (M N : Tm Γ A) : Set l where 154 | -- no-eta-equality 155 | constructor MkTmMorph 156 | field 157 | morph : (γ : Obj Γ) -> Morph ((A ₀) γ) ((M ₀') γ) ((N ₀') γ) 158 | natural : isNatural _ _ (M ◂) (N ◂) (λ γ → id Γ _ , overFidL A (morph γ)) 159 | open TmMorph 160 | 161 | postulate 162 | TmMorphEq : {M N : Tm Γ A} {f g : TmMorph M N} 163 | -> morph f ≡ morph g -> f ≡ g 164 | -- TmMorphEq {M} {N} {f} {g} h = {!!} 165 | 166 | open TmMorph 167 | 168 | Tmᶜ : (Γ : Category) (A : Ty Γ) -> Category 169 | Obj (Tmᶜ Γ A) = Tm Γ A 170 | Morph (Tmᶜ Γ A) M N = TmMorph M N 171 | id (Tmᶜ Γ A) M = MkTmMorph (λ γ → id ((A ₀) γ) ((M ₀') γ)) λ {γ} {γ'} f → 172 | let τ = λ γ → id ((A ₀) γ) ((M ₀') γ) 173 | goal = ap ((A ₀) γ' ∘ (M ₁') f) (fid ((A ₁) f) ((M ₀') γ)) 174 | · ∘id ((A ₀) γ') _ · sym (id∘ ((A ₀) γ') _) 175 | sub = MU.substMorph ((A ₀) γ') 176 | (ap (_$ _) $ ap _₀ $ ap (A ₁) (∘id Γ f · sym (id∘ Γ f))) 177 | goal' = begin 178 | _ ≡⟨ ap sub (ap (_∘_ ((A ₀) γ') ((M ₁') f)) (ap (overF∘L A (id Γ γ) f) 179 | (Fcomm-SM ((A ₁) f) (overFid-prf A _) (τ γ)))) ⟩ 180 | _ ≡⟨ ap sub (ap ((A ₀) γ' ∘ _) 181 | (MU.joinSM-2 ((A ₀) γ') _ _ (((A ₁) f) ₁ $ (τ γ)))) ⟩ 182 | _ ≡⟨ ap sub (MU.substMorph∘ ((A ₀) γ') _ _ _) ⟩ 183 | _ ≡⟨ MU.joinSM-2 ((A ₀) γ') _ _ (_∘_ ((A ₀) γ') ((M ₁') f) (((A ₁) f) ₁ $ (τ γ))) ⟩ 184 | _ ≡⟨ MU.substMorphL-irrel ((A ₀) γ') _ (strct ((A ₀) γ') _ _) ⟩ 185 | _ ≡⟨ ap (MU.substMorph ((A ₀) γ') _) goal ⟩ 186 | _ ≡⟨ sym (MU.joinSM-2 ((A ₀) γ') _ _ _) ⟩ 187 | _ ≡⟨ ap (overF∘L A f (id Γ γ')) (sym (MU.substMorph2∘ ((A ₀) γ') _ _ _ _)) ⟩ 188 | _ ≡⟨ ap (overF∘L A f (id Γ γ')) (ap ((A ₀) γ' ∘ overFidL A (τ γ')) 189 | (sym (IdFun-lemma A ((M ₁') f)))) ⟩ 190 | _ ≡⟨ sym (MU.substMorph∘ ((A ₀) γ') _ _ _) ⟩ 191 | _ ∎ 192 | in Σ-≡ (∘id Γ f · sym (id∘ Γ f) , goal') 193 | 194 | _∘_ (Tmᶜ Γ A) M N = 195 | MkTmMorph (λ γ → _∘_ ((A ₀) γ) (morph M γ) (morph N γ)) {!!} 196 | hom-set (Tmᶜ Γ A) = {!!} 197 | id∘ (Tmᶜ Γ A) f = TmMorphEq (funExt _ (λ x → id∘ ((A ₀) x) (morph f x))) 198 | ∘id (Tmᶜ Γ A) f = TmMorphEq (funExt _ (λ x → ∘id ((A ₀) x) (morph f x))) 199 | ∘∘ (Tmᶜ Γ A) f g h = 200 | TmMorphEq (funExt _ (λ x → ∘∘ ((A ₀) x) (morph f x) (morph g x) (morph h x))) 201 | -------------------------------------------------------------------------------- /CategoryModel/MorphUtils.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --allow-unsolved-metas #-} 2 | 3 | module CategoryModel.MorphUtils where 4 | 5 | open import CategoryTheory 6 | open import Cubical.Core.Prelude 7 | open import Utils renaming (_·_ to _▪_) 8 | open import Agda.Primitive 9 | 10 | module MU {l l'} (C : Category {l} {l'}) where 11 | 12 | open Category C 13 | open Functor 14 | 15 | substMorph : {a b c : Category.Obj C} 16 | -> a ≡ b -> Morph a c -> Morph b c 17 | substMorph p u = subst (λ z → Morph z _) p u 18 | 19 | substMorph2 : ∀{a b c d} -> a ≡ c -> b ≡ d -> Morph a b -> Morph c d 20 | substMorph2 {a} {b} {_} {d} = 21 | J (λ c' p' → b ≡ d -> Morph a b -> Morph c' d) 22 | (J (λ d' q' → Morph a b -> Morph a d') λ x → x) 23 | 24 | substMorph2-refl : ∀{a b} (m : Morph a b) -> substMorph2 refl refl m ≡ m 25 | substMorph2-refl m = transpRefl _ _ ▪ {!!} 26 | 27 | substMorph∘ : ∀{a b c d} (p : a ≡ b) (m : Morph a c) (m' : Morph c d) 28 | -> m' ∘ (substMorph p m) ≡ substMorph p (m' ∘ m) 29 | substMorph∘ {a} {_} {c} {d} = J (λ b' p' → (m : Morph a c) (m' : Morph c d) 30 | -> m' ∘ (substMorph p' m) ≡ substMorph p' (m' ∘ m)) 31 | λ m m' → ap (m' ∘_) (transpRefl _ m) ▪ sym (transpRefl _ _) 32 | 33 | substMorph2∘ : ∀{a a' b b' c} (p : a ≡ a') (q : b ≡ b') (m : Morph a b) (m' : Morph b c) 34 | -> substMorph q m' ∘ substMorph2 p q m ≡ substMorph p (m' ∘ m) 35 | substMorph2∘ = J (λ a'' p' → (q : _ ≡ _) (m : Morph _ _) (m' : Morph _ _) 36 | -> substMorph q m' ∘ substMorph2 p' q m ≡ substMorph p' (m' ∘ m)) 37 | (J (λ b'' q' → (m : Morph _ _) (m' : Morph _ _) 38 | -> substMorph q' m' ∘ substMorph2 refl q' m ≡ substMorph refl (m' ∘ m)) 39 | λ m m' → ap (substMorph refl m' ∘_) (substMorph2-refl m) 40 | ▪ (ap (_∘ m) (transpRefl _ _) ▪ sym (transpRefl _ _))) 41 | 42 | joinSM-2 : ∀{a b c e} (p : a ≡ b) (q : b ≡ c) (m : Morph a e) 43 | -> substMorph q (substMorph p m) ≡ substMorph (p ▪ q) m 44 | joinSM-2 = {!!} 45 | 46 | joinSM : ∀{a b c d e} (p : a ≡ b) (q : b ≡ c) (r : c ≡ d) (m : Morph a e) 47 | -> substMorph r (substMorph q (substMorph p m)) ≡ substMorph (p ▪ q ▪ r) m 48 | joinSM p q r m = {!!} 49 | 50 | remove-SM : ∀{a b} -> isSet Obj -> (p : a ≡ a) (m : Morph a b) 51 | -> substMorph p m ≡ m 52 | remove-SM {a} h p m = K h a (λ p' → substMorph p' m ≡ m) (transpRefl _ _) p 53 | 54 | substMorphR : {a b c : Category.Obj C} 55 | -> b ≡ c -> Morph a b -> Morph a c 56 | substMorphR p u = subst (Morph _) p u 57 | 58 | substMorphL-irrel : ∀{a b c} {p q : a ≡ b} (m : Morph a c) 59 | -> p ≡ q -> substMorph p m ≡ substMorph q m 60 | substMorphL-irrel = {!!} 61 | 62 | substMorphR-irrel : ∀{a b c} {p q : b ≡ c} (m : Morph a b) 63 | -> p ≡ q -> substMorphR p m ≡ substMorphR q m 64 | substMorphR-irrel = {!!} 65 | 66 | remove-SMR : ∀{a b} -> isSet Obj -> (p : a ≡ a) (m : Morph b a) 67 | -> substMorphR p m ≡ m 68 | remove-SMR {a} h p m = {!!} -- K h a (λ p' → substMorph p' m ≡ m) (transpRefl _ _) p 69 | 70 | joinSMR-2 : ∀{a b c e} (p : a ≡ b) (q : b ≡ c) (m : Morph e a) 71 | -> substMorphR q (substMorphR p m) ≡ substMorphR (p ▪ q) m 72 | joinSMR-2 p q m = {!!} 73 | 74 | joinSMR-3 : ∀{a b c d e} (p : a ≡ b) (q : b ≡ c) (r : c ≡ d) (m : Morph e a) 75 | -> substMorphR r (substMorphR q (substMorphR p m)) ≡ substMorphR (p ▪ q ▪ r) m 76 | joinSMR-3 p q r m = {!!} 77 | 78 | substMorphR∘ : ∀{a b c d} (p : c ≡ d) (m : Morph a b) (m' : Morph b c) 79 | -> substMorphR p m' ∘ m ≡ substMorphR p (m' ∘ m) 80 | substMorphR∘ = {!!} 81 | 82 | substMorph2∘' : ∀{a b b' c c'} (p : b ≡ b') (q : c ≡ c') (m : Morph a b) (m' : Morph b c) 83 | -> substMorph2 p q m' ∘ substMorphR p m ≡ substMorphR q (m' ∘ m) 84 | substMorph2∘' p q m m' = {!!} 85 | 86 | module _ {l} {l'} {l''} {l'''} 87 | {C : Category {l} {l'}} 88 | {D : Category {l''} {l'''}} 89 | (F : C ⟶ D) where 90 | 91 | open Category 92 | open Functor 93 | 94 | Fcomm-SM : {a b c : _} (p : a ≡ b) (m : Morph C a c) 95 | -> (F ₁) (MU.substMorph C p m) ≡ MU.substMorph D (ap (F ₀) p) ((F ₁) m) 96 | Fcomm-SM = J (λ b' p' → (m : Morph C _ _) 97 | -> (F ₁) (MU.substMorph C p' m) ≡ MU.substMorph D (ap (F ₀) p') ((F ₁) m)) 98 | λ m → ap (F ₁) (transpRefl _ m) ▪ sym (transpRefl _ _) 99 | 100 | fid-SM : {x y : _} (p : x ≡ y) 101 | -> (F ₁) (MU.substMorph C p (id C x)) 102 | ≡ MU.substMorph D (ap (F ₀) p) (id D ((F ₀) x)) 103 | fid-SM {x} = J (λ y' p' → (F ₁) (MU.substMorph C p' (id C x)) 104 | ≡ MU.substMorph D (ap (F ₀) p') (id D ((F ₀) x))) 105 | (ap (F ₁) (transpRefl (Morph C x x) (id C x)) 106 | ▪ fid F x ▪ sym {!!}) 107 | 108 | open import Function using (_$_) 109 | 110 | 111 | module _ {l} {C D : Category {l} {l}} {F G : Functor C D} where 112 | open Category 113 | open Functor 114 | 115 | onF≡ : F ≡ G -> FunctorEq C D (F ₀) (λ a b → F ₁) (G ₀) (λ a b → G ₁) 116 | onF≡ = J (λ G' p' → FunctorEq C D (F ₀) (λ a b → F ₁) (G' ₀) (λ a b → G' ₁)) 117 | (FunctorEq-refl F) 118 | 119 | module TyUtils {l} (strct : (C : Category {l} {l}) → isStrictCategory C) where 120 | 121 | open CatCategory strct 122 | open Category 123 | open Functor 124 | 125 | module _ {C : Category {l} {l}} (F : C ⟶ Cat) where 126 | 127 | private 128 | idC = id C 129 | 130 | infixr 6 _·_ 131 | _·_ : ∀{γ γ'} -> Morph C γ γ' -> Obj ((F ₀) γ) -> Obj ((F ₀) γ') 132 | p · a = ((F ₁) p ₀) a 133 | 134 | asder : ∀{a b b' c} 135 | -> (p : Morph C a b) (q : Morph C b c) 136 | -> (p' : Morph C a b') (q' : Morph C b' c) 137 | -> (x : Obj ((F ₀) a)) 138 | -> _∘_ C q p ≡ _∘_ C q' p' 139 | -> (((F ₁) q) ₀) ((((F ₁) p) ₀) x) ≡ (((F ₁) q') ₀) ((((F ₁) p') ₀) x) 140 | asder p q p' q' x h = 141 | ap (_$ x) (ap _₀ (sym (f∘ F q p))) 142 | ▪ ap (λ z → (((F ₁) z) ₀) x) h 143 | ▪ ap (_$ x) (ap _₀ (f∘ F q' p')) 144 | 145 | module _ {γ} where 146 | 147 | open MU ((F ₀) γ) 148 | 149 | overFid-prf : ∀ a -> a ≡ idC γ · a 150 | overFid-prf a = sym (ap (_$ a) $ ap _₀ $ fid F γ) 151 | 152 | overFidL : ∀{a b} -> Morph ((F ₀) γ) a b -> Morph ((F ₀) γ) (idC γ · a) b 153 | overFidL {a} = substMorph (overFid-prf a) 154 | 155 | overFidR : ∀{a b} -> Morph ((F ₀) γ) a b -> Morph ((F ₀) γ) a (idC γ · b) 156 | overFidR {_} {b} = substMorphR (overFid-prf b) 157 | 158 | IdFun-lemma : ∀{a b} (m : Morph ((F ₀) γ) a b) 159 | -> ((F ₁) (idC γ) ₁) m 160 | ≡ MU.substMorph2 ((F ₀) γ) (overFid-prf a) (overFid-prf b) m 161 | IdFun-lemma {a} {b} m = {!eq1 (onF≡ (fid F γ)) m!} 162 | where open FunctorEq 163 | 164 | module _ {γ γ' γ''} (p : Morph C γ γ') (p' : Morph C γ' γ'') where 165 | 166 | open MU ((F ₀) γ'') 167 | 168 | overF∘-prf : ∀ x -> p' · p · x ≡ _∘_ C p' p · x 169 | overF∘-prf x = sym (ap (_$ x) $ ap _₀ $ f∘ F p' p) 170 | 171 | overF∘L : {x : _} {y : _} 172 | -> Morph ((F ₀) γ'') (p' · p · x) y 173 | -> Morph ((F ₀) γ'') (_∘_ C p' p · x) y 174 | overF∘L {x} = substMorph (overF∘-prf x) 175 | 176 | overF∘R : {x : _} {y : _} 177 | -> Morph ((F ₀) γ'') x (p' · p · y) 178 | -> Morph ((F ₀) γ'') x (_∘_ C p' p · y) 179 | overF∘R {_} {y} = substMorphR (overF∘-prf y) 180 | 181 | module _ {γ γ' γ''} (p : Morph C γ γ') (p' : Morph C γ' γ'') where 182 | 183 | open MU ((F ₀) γ'') 184 | 185 | overF∘L-comp : {x : _} {y z : _} 186 | (m : Morph ((F ₀) γ'') (p' · p · x) y) 187 | (m' : Morph ((F ₀) γ'') y z) 188 | -> _∘_ ((F ₀) γ'') m' (overF∘L p p' m) ≡ overF∘L p p' (_∘_ ((F ₀) γ'') m' m) 189 | overF∘L-comp m m' = substMorph∘ _ m m' 190 | 191 | overF∘R-comp : {x : _} {y : _} {z : _} 192 | (m : Morph ((F ₀) γ'') z x) 193 | (m' : Morph ((F ₀) γ'') x (p' · p · y)) 194 | -> _∘_ ((F ₀) γ'') (overF∘R p p' m') m ≡ overF∘R p p' (_∘_ ((F ₀) γ'') m' m) 195 | overF∘R-comp m m' = substMorphR∘ _ m m' 196 | -------------------------------------------------------------------------------- /CategoryModel/PiTypes.agda: -------------------------------------------------------------------------------- 1 | module CategoryModel.PiTypes {l} where 2 | 3 | open import Function using (_$_) 4 | open import Cubical.Core.Prelude 5 | open import CategoryTheory 6 | open import Utils 7 | open import Agda.Primitive 8 | open import CategoryModel.MorphUtils 9 | open import CategoryModel.Basics {l} 10 | 11 | open TyUtils strct 12 | 13 | module _ {Γ : Category} (A : Ty (Γ ᵒᵖ)) (B : Ty (Γ ,,op A)) where 14 | 15 | open Functor 16 | open Tm 17 | open Category 18 | 19 | private 20 | Π' : (γ : Obj Γ) -> Ty ((A ₀) γ) 21 | (Π' γ ₀) x = (B ₀) (γ , x) 22 | (Π' γ ₁) {a = a} {b} p = (B ₁) (id Γ _ , overFidR A p) 23 | fid (Π' γ) x = fid B (γ , x) 24 | f∘ (Π' γ) f g = 25 | ap (B ₁) (Σ-≡ (sym (id∘ Γ _) , goal)) · 26 | f∘ B (id Γ γ , overFidR A f) (id Γ γ , overFidR A g) 27 | where 28 | open MU ((A ₀) γ) 29 | goal = begin 30 | _ ≡⟨ joinSMR-2 _ _ _ ⟩ 31 | _ ≡⟨ substMorphR-irrel _ (strct ((A ₀) γ) _ _) ⟩ 32 | _ ≡⟨ sym (joinSMR-3 _ _ _ _) ⟩ 33 | _ ≡⟨ ap (overF∘R A _ _) (ap (substMorphR _) 34 | (sym $ substMorphR∘ (overFid-prf A _) g f)) ⟩ 35 | _ ≡⟨ ap (overF∘R A _ _) (sym (substMorph2∘' _ _ _ _)) ⟩ 36 | _ ≡⟨ ap (overF∘R A _ _) (ap (λ z → _∘_ ((A ₀) γ) z (overFidR A g)) 37 | (sym $ IdFun-lemma A (overFidR A f))) ⟩ 38 | _ ≡⟨ sym (overF∘R-comp A _ _ _ _) ⟩ 39 | _ ∎ 40 | 41 | Π'-fun : ∀{γ γ'} -> Morph Γ γ γ' 42 | -> Tmᶜ ((A ₀) γ) (Π' γ) ⟶ Tmᶜ ((A ₀) γ') (Π' γ') 43 | ((Π'-fun p ₀) M ₀') a = 44 | (((B ₁) (p , idA)) ₀) ((M ₀') ((((A ₁) p) ₀) a)) 45 | where idA = id ((A ₀) _) _ 46 | ((Π'-fun {γ} {γ'} p ₀) M ₁') {a} {a'} q = 47 | MU.substMorph ((B ₀) (γ' , a')) prf aux 48 | where 49 | p·a' = ((A ₁) p ₀) a' ; p·q = ((((A ₁) p) ₁) q) 50 | aux = (((B ₁) (p , (id ((A ₀) γ) p·a'))) ₁) ((M ₁') p·q) 51 | prf = asder B _ _ _ _ _ 52 | (p-id-q-lemma {Γ} A p q · sym (p-id-q-lemma' {Γ} A p q)) 53 | fid' ((Π'-fun {γ} {γ'} p ₀) M) a = {!!} 54 | f∘' ((Π'-fun {γ} {γ'} p ₀) M) = {!!} 55 | fst ((Π'-fun {γ} {γ'} p ₁) (τ , _)) a = 56 | ((B ₁) (p , id ((A ₀) γ) _) ₁) (τ (((A ₁) p ₀) a)) 57 | snd ((Π'-fun {γ} {γ'} p ₁) (τ , nat-τ)) = {!!} 58 | fid (Π'-fun {γ} {γ'} p) x = 59 | Σ-≡ (funExt _ (λ a → fid ((B ₁) (p , id ((A ₀) γ) _)) _) , 60 | {!!}) 61 | f∘ (Π'-fun {γ} {γ'} p) = {!!} 62 | 63 | Π : Ty Γ 64 | (Π ₀) γ = Tmᶜ ((A ₀) γ) (Π' γ) 65 | (Π ₁) {γ} {γ'} p = Π'-fun p 66 | fid Π x = {!!} 67 | f∘ Π = {!!} 68 | 69 | module _ {Γ : Category} (A : Ty (Γ ᵒᵖ)) (B : Ty (Γ ,,op ty-op A)) where 70 | 71 | open Functor 72 | open Category 73 | open Tm 74 | 75 | Πᵒᵖ' : (γ : Obj Γ) -> Ty (((ty-op A) ₀) γ) 76 | (Πᵒᵖ' γ ₀) x = (B ₀) (γ , x) 77 | (Πᵒᵖ' γ ₁) {a = a} {b} p = (B ₁) (id Γ _ , overFidL A p) 78 | fid (Πᵒᵖ' γ) a = {!!} 79 | f∘ (Πᵒᵖ' γ) = {!!} 80 | 81 | Πᵒᵖ'-fun : ∀{γ γ'} -> Morph Γ γ γ' 82 | -> Tmᶜ (((ty-op A) ₀) γ) (Πᵒᵖ' γ) ⟶ Tmᶜ (((ty-op A) ₀) γ') (Πᵒᵖ' γ') 83 | (((Πᵒᵖ'-fun {γ} {γ'} p ₀) M) ₀') a = 84 | (((B ₁) (p , id ((A ₀) γ) _)) ₀) ((M ₀') ((((A ₁) p) ₀) a)) 85 | (Πᵒᵖ'-fun p ₁) = {!!} 86 | 87 | Πᵒᵖ : Ty Γ 88 | (Πᵒᵖ ₀) γ = Tmᶜ (((ty-op A) ₀) γ) (Πᵒᵖ' γ) 89 | (Πᵒᵖ ₁) p = Πᵒᵖ'-fun p 90 | fid Πᵒᵖ = {!!} 91 | f∘ Πᵒᵖ = {!!} 92 | -------------------------------------------------------------------------------- /CategoryModel/SigmaTypes.agda: -------------------------------------------------------------------------------- 1 | module CategoryModel.SigmaTypes {l} where 2 | 3 | open import Function using (_$_) 4 | open import Cubical.Core.Prelude 5 | open import CategoryTheory 6 | open import Utils 7 | open import Agda.Primitive 8 | open import CategoryModel.MorphUtils 9 | open import CategoryModel.Basics {l} 10 | 11 | open TyUtils strct 12 | 13 | module _ {Γ : Category} (A : Ty Γ) (B : Ty (Γ ,, A)) where 14 | 15 | open Functor 16 | open Category 17 | 18 | module _ (γ : Obj Γ) where 19 | B' : Ty ((A ₀) γ) 20 | (B' ₀) x = (B ₀) (γ , x) 21 | (B' ₁) f = (B ₁) (id Γ γ , overFidL A f) 22 | fid B' = {!!} 23 | f∘ B' = {!!} 24 | 25 | module _ {γ γ' : Obj Γ} (p : Morph Γ γ γ') where 26 | 27 | aux : ((A ₀) γ ,, B' γ) ⟶ ((A ₀) γ' ,, B' γ') 28 | (aux ₀) (a , b) = ((A ₁) p ₀) a , ((B ₁) (p , id ((A ₀) γ') _) ₀) b 29 | (aux ₁) {a , b} {a' , b'} (f , g) = 30 | ((A ₁) p ₁) f , MU.substMorph ((B ₀) (γ' , p·a')) 31 | (asder B _ _ _ _ b {!!}) g' 32 | where 33 | p·a = ((A ₁) p ₀) a 34 | p·a' = ((A ₁) p ₀) a' 35 | g' = ((B ₁) (p , id ((A ₀) γ') _) ₁) g 36 | 37 | fid aux = {!!} 38 | f∘ aux = {!!} 39 | 40 | Σ-ty : Ty Γ 41 | (Σ-ty ₀) γ = (A ₀) γ ,, (B' γ) 42 | (Σ-ty ₁) f = aux f 43 | fid Σ-ty γ = {!!} 44 | f∘ Σ-ty = {!!} 45 | 46 | 47 | module _ {Γ : Category} (A : Ty Γ) (B : Ty (Γ ,, ty-op A)) where 48 | 49 | open Functor 50 | open Category 51 | 52 | module _ (γ : Obj Γ) where 53 | 54 | Bop' : Ty (((A ₀) γ) ᵒᵖ) 55 | (Bop' ₀) x = (B ₀) (γ , x) 56 | (Bop' ₁) f = (B ₁) (id Γ γ , overFidR A f) 57 | fid Bop' = {!!} 58 | f∘ Bop' = {!!} 59 | 60 | module _ {γ γ' : Obj Γ} (p : Morph Γ γ γ') where 61 | 62 | auxop : ((A ₀) γ ,,op Bop' γ) ⟶ ((A ₀) γ' ,,op Bop' γ') 63 | (auxop ₀) (a , b) = ((A ₁) p ₀) a , ((B ₁) (p , id ((A ₀) γ') _) ₀) b 64 | (auxop ₁) {a , b} {a' , b'} (f , g) = 65 | ((A ₁) p ₁) f , MU.substMorphR ((B ₀) (γ' , p·a)) {!!} g' 66 | where 67 | p·a = ((A ₁) p ₀) a 68 | p·a' = ((A ₁) p ₀) a' 69 | g' = ((B ₁) (p , id ((A ₀) γ') _) ₁) g 70 | fid auxop = {!!} 71 | f∘ auxop = {!!} 72 | 73 | Σop-ty : Ty Γ 74 | (Σop-ty ₀) γ = (A ₀) γ ,,op Bop' γ 75 | (Σop-ty ₁) p = auxop p 76 | fid Σop-ty = {!!} 77 | f∘ Σop-ty = {!!} 78 | -------------------------------------------------------------------------------- /CategoryTheory.agda: -------------------------------------------------------------------------------- 1 | module CategoryTheory where 2 | 3 | open import Cubical.Core.Glue 4 | open import Cubical.Basics.Equiv 5 | open import Utils 6 | open import Function using (_$_ ; const) 7 | open import Agda.Primitive 8 | open import Cubical.Core.Prelude hiding (_∧_ ; _×_) 9 | -- open import IrrelevantProp 10 | open import Data.Product 11 | 12 | module _ {l} where 13 | 14 | record Wrap (A : Set l) : Set (lsuc l) where 15 | constructor MkWrap 16 | field 17 | unWrap : A 18 | open Wrap 19 | 20 | module _ {A : Set l} {x y : A} where 21 | 22 | Wrap-≡ : x ≡ y -> MkWrap x ≡ MkWrap y 23 | Wrap-≡ p = ap MkWrap p 24 | 25 | Wrap-≡⁻¹ : MkWrap x ≡ MkWrap y -> x ≡ y 26 | Wrap-≡⁻¹ p = ap unWrap p 27 | 28 | Wrap-≡-iso1 : (p : x ≡ y) -> Wrap-≡⁻¹ (Wrap-≡ p) ≡ p 29 | Wrap-≡-iso1 _ = refl 30 | 31 | Wrap-≡-iso2 : (p : MkWrap x ≡ MkWrap y) -> Wrap-≡ (Wrap-≡⁻¹ p) ≡ p 32 | Wrap-≡-iso2 _ = refl 33 | 34 | record Category {l} {l'} : Set (lsuc (l ⊔ l')) where 35 | no-eta-equality 36 | field 37 | Obj : Set l 38 | Morph : Obj → Obj → Set l' 39 | id : ∀ I → Morph I I 40 | _∘_ : ∀{I J K : Obj} → Morph J K → Morph I J → Morph I K 41 | 42 | hom-set : ∀{a b : Obj} → isSet (Morph a b) 43 | id∘ : ∀{i j} (f : Morph i j) → id j ∘ f ≡ f 44 | ∘id : ∀{i j} (f : Morph i j) → f ∘ id i ≡ f 45 | ∘∘ : ∀{i j k l} (f : Morph k l) (g : Morph j k) (h : Morph i j) 46 | → (f ∘ g) ∘ h ≡ f ∘ (g ∘ h) 47 | 48 | ⊤-cat : ∀{l l'} -> Category {l} {l'} 49 | ⊤-cat = record 50 | { Obj = ⊤ 51 | ; Morph = λ _ _ → ⊤ 52 | ; id = λ _ → tt 53 | ; _∘_ = λ _ _ → tt 54 | ; hom-set = ⊤-is-set 55 | ; id∘ = λ _ → refl 56 | ; ∘id = λ _ → refl 57 | ; ∘∘ = λ _ _ _ → refl 58 | } 59 | 60 | module _ {l} (A : Set l) (aset : isSet A) where 61 | 62 | open Category 63 | open import Cubical.Core.PropositionalTruncation 64 | 65 | -- discrete category 66 | Δ : Category {l} {l} 67 | Obj Δ = A 68 | Morph Δ a b = a ≡ b 69 | id Δ x = refl 70 | _∘_ Δ p q = q · p 71 | hom-set Δ = propIsSet _ (aset _ _) 72 | id∘ Δ f = aset _ _ _ f 73 | ∘id Δ f = aset _ _ _ _ 74 | ∘∘ Δ _ _ _ = aset _ _ _ _ 75 | 76 | module _ {l} {l'} {l''} {l'''} (C : Category {l} {l'}) (D : Category {l''} {l'''}) where 77 | 78 | open Category 79 | 80 | cross : Category 81 | Obj cross = Obj C × Obj D 82 | Morph cross (c , d) (c' , d') = Morph C c c' × Morph D d d' 83 | id cross (x , y) = (id C x) , (id D y) 84 | _∘_ cross (f , f') (g , g') = _∘_ C f g , _∘_ D f' g' 85 | hom-set cross = Σ-set (hom-set C) (λ _ → hom-set D) 86 | id∘ cross (f1 , f2) = ×-≡ (id∘ C f1) (id∘ D f2) 87 | ∘id cross (f1 , f2) = ×-≡ (∘id C f1) (∘id D f2) 88 | ∘∘ cross (f1 , f2) (g1 , g2) (h1 , h2) = ×-≡ (∘∘ C f1 g1 h1) (∘∘ D f2 g2 h2) 89 | 90 | module _ {l} {l'} (C : Category {l} {l'}) where 91 | 92 | open Category C 93 | 94 | _isInverseOf_ : ∀{a b} -> Morph b a -> Morph a b -> Set _ 95 | g isInverseOf f = g ∘ f ≡ id _ × f ∘ g ≡ id _ 96 | 97 | isIso : ∀{a b} → Morph a b → Set _ 98 | isIso {a} {b} f = Σ (Morph b a) λ g → g isInverseOf f 99 | 100 | inverseUnique : ∀{a b} (f : Morph a b) (g1 g2 : Morph b a) 101 | -> g1 isInverseOf f -> g2 isInverseOf f 102 | -> g1 ≡ g2 103 | inverseUnique f g1 g2 h1 h2 = 104 | sym (id∘ g1) · ap (_∘ g1) (sym (fst h2)) · ∘∘ g2 f g1 105 | · ap (g2 ∘_) (snd h1) · ∘id g2 106 | 107 | -- isIsoIsProp : ∀{a b} -> (u : Morph a b) -> isProp (isIso u) 108 | -- isIsoIsProp u = {!!} 109 | 110 | _≅_ : Obj -> Obj -> Set _ 111 | A ≅ B = Σ (Morph A B) isIso 112 | 113 | module _ {A B : Obj} where 114 | 115 | -- ≅IsSet : isSet (A ≅ B) 116 | -- ≅IsSet = Σ-subset hom-set isIsoIsProp 117 | 118 | -- idtoiso : A ≡ B -> A ≅ B 119 | -- idtoiso = J (λ B' p → A ≅ B') (id A , id A , id∘ _ , id∘ _) 120 | 121 | -- idtoiso-equiv : isEquiv idtoiso -> isSet (A ≡ B) 122 | -- idtoiso-equiv eqv = subst isSet (ua ({!!} , {!!})) ≅IsSet 123 | 124 | isPreCategory : Set _ 125 | isPreCategory = ∀{a b : Obj} → {f g : Morph a b} → isProp (f ≡ g) 126 | 127 | isStrictCategory : Set l 128 | isStrictCategory = ∀{a b : Obj} → isProp (a ≡ b) 129 | 130 | _ᵒᵖ : Category 131 | _ᵒᵖ = record 132 | { Obj = Obj 133 | ; Morph = λ x y → Morph y x 134 | ; _∘_ = λ f g → g ∘ f 135 | ; id = id 136 | ; ∘∘ = λ { f g h → let aux = ∘∘ h g f in sym aux } 137 | ; id∘ = λ { f → ∘id f } 138 | ; ∘id = λ { f → id∘ f } 139 | ; hom-set = hom-set 140 | } 141 | 142 | module _ {l} (C : Category {l} {l}) where 143 | 144 | open Category C 145 | 146 | Lift : Category {lsuc l} {lsuc l} 147 | Obj Lift = Wrap {l} Obj 148 | Morph Lift (MkWrap x) (MkWrap y) = Wrap (Morph x y) 149 | id Lift (MkWrap x) = MkWrap (id x) 150 | _∘_ Lift (MkWrap f) (MkWrap g) = MkWrap (f ∘ g) 151 | hom-set Lift (MkWrap x) (MkWrap y) p q = 152 | let p' = (Wrap-≡⁻¹ p) 153 | q' = (Wrap-≡⁻¹ q) 154 | in sym (Wrap-≡-iso1 p) · ap Wrap-≡ (hom-set x y p' q') · Wrap-≡-iso2 q 155 | id∘ Lift (MkWrap f) = Wrap-≡ (id∘ f) 156 | ∘id Lift (MkWrap f) = Wrap-≡ (∘id f) 157 | ∘∘ Lift (MkWrap f) (MkWrap g) (MkWrap h) = Wrap-≡ (∘∘ f g h) 158 | 159 | liftStrict : isStrictCategory C -> isStrictCategory Lift 160 | liftStrict h {MkWrap a} {MkWrap b} p q = 161 | let p' = (Wrap-≡⁻¹ p) 162 | q' = (Wrap-≡⁻¹ q) 163 | in sym (Wrap-≡-iso1 p) · ap Wrap-≡ (h {a} {b} p' q') · Wrap-≡-iso2 q 164 | 165 | module _ {l l' l'' l'''} (C : Category {l} {l'}) (D : Category {l''} {l'''}) where 166 | 167 | record Functor : Set (l ⊔ l' ⊔ l'' ⊔ l''') where 168 | constructor MkFunct 169 | open Category 170 | field 171 | _₀ : Obj C → Obj D 172 | _₁ : ∀{a b} → Morph C a b → Morph D (_₀ a) (_₀ b) 173 | fid : (∀ x → _₁ (id C x) ≡ id D (_₀ x)) 174 | f∘ : (∀{i j k} (f : Morph C j k) (g : Morph C i j) 175 | → _₁ (_∘_ C f g) ≡ _∘_ D (_₁ f) (_₁ g)) 176 | 177 | record Functor' : Set (lsuc (l ⊔ l' ⊔ l'' ⊔ l''')) where 178 | constructor MkFunctor' 179 | field 180 | unFunctor' : Functor 181 | 182 | _⟶_ = Functor 183 | 184 | module _ where 185 | open Category 186 | 187 | ObjPart : Set _ 188 | ObjPart = Obj C → Obj D 189 | 190 | MorphPart : ObjPart → Set _ 191 | MorphPart _₀ = ∀ a b → Morph C a b → Morph D (_₀ a) (_₀ b) 192 | 193 | ObjPartEq : ObjPart -> ObjPart -> Set _ 194 | ObjPartEq F0 G0 = (x : _) -> F0 x ≡ G0 x 195 | 196 | MorphPartEq : {F0 G0 : ObjPart} -> ObjPartEq F0 G0 -> MorphPart F0 -> MorphPart G0 -> Set _ 197 | MorphPartEq {F0} {G0} eq0 F1 G1 = 198 | ∀{a b} (f : Morph C a b) 199 | -> _≡_ {A = Morph D (G0 a) (G0 b)} 200 | (subst2 (Morph D) (eq0 a) (eq0 b) (F1 a b f)) (G1 a b f) 201 | 202 | funeq-lemma : {F0 G0 : ObjPart} (p : F0 ≡ G0) 203 | -> {F1 : MorphPart F0} {G1 : MorphPart G0} 204 | -> MorphPartEq (λ x → ap (_$ x) p) F1 G1 205 | -> _≡_ {A = MorphPart G0} (subst MorphPart p F1) G1 206 | funeq-lemma {F0} = 207 | J (λ G0' p' -> {F1 : MorphPart F0} {G1 : MorphPart G0'} 208 | -> MorphPartEq (λ x → ap (_$ x) p') F1 G1 209 | -> _≡_ {A = MorphPart G0'} (subst MorphPart p' F1) G1) 210 | λ {F1} {G1} h → transpRefl (MorphPart F0) F1 · 211 | aux (λ f → sym (transpRefl _ _ · transpRefl _ _) · h f) 212 | where 213 | aux : {F0 : ObjPart} {F1 F1' : MorphPart F0} 214 | -> ((∀{a b} (f : Morph C a b) -> F1 a b f ≡ F1' a b f)) 215 | -> _≡_ {A = MorphPart F0} F1 F1' 216 | aux h = funExt _ (λ _ → funExt _ (λ _ → funExt _ (λ f → h f))) 217 | 218 | record FunctorEq (F0 : ObjPart) (F1 : MorphPart F0) 219 | (G0 : ObjPart) (G1 : MorphPart G0) : Set (l ⊔ l' ⊔ l'' ⊔ l''') where 220 | field 221 | eq0 : (x : _) -> F0 x ≡ G0 x 222 | eq1 : MorphPartEq eq0 F1 G1 -- ∀{a b} (f : Morph C a b) 223 | -- -> _≡_ {A = Morph D (G0 a) (G0 b)} 224 | -- (subst2 (Morph D) (eq0 a) (eq0 b) (F1 f)) (G1 f) 225 | 226 | Functoriality : (o : ObjPart) -> MorphPart o -> Set _ 227 | Functoriality F₀ F₁ = 228 | (∀ x → F₁ _ _ (id C x) ≡ id D (F₀ x)) 229 | × (∀{i j k} (f : Morph C j k) (g : Morph C i j) 230 | → F₁ _ _ (_∘_ C f g) ≡ _∘_ D (F₁ _ _ f) (F₁ _ _ g)) 231 | 232 | functIsProp : (o : ObjPart) -> (m : MorphPart o) -> isProp (Functoriality o m) 233 | functIsProp F₀ F₁ = ×-prop (Π-prop (λ x → hom-set D _ _)) 234 | λ f g → funExt' _ $ λ i → funExt' _ $ λ j → funExt' _ $ λ k → funExt _ $ λ x → 235 | funExt _ (λ y → hom-set D _ _ (f x y) (g x y)) 236 | 237 | funct≃Σ : Functor ≃ Σ (Σ ObjPart MorphPart) λ { (o , m) → Functoriality o m } 238 | funct≃Σ = 239 | isoToEquiv 240 | (λ { (MkFunct F₀ F₁ x y) → (F₀ , λ a b -> F₁) , (x , y) }) 241 | (λ { ((F₀ , F₁) , (x , y)) → MkFunct F₀ (F₁ _ _) x y }) 242 | (λ { ((F₀ , F₁) , (x , y)) → refl }) 243 | (λ { (MkFunct _₀ _₁ fid₁ f∘₁) → refl }) 244 | 245 | postulate -- postulated because too slow 246 | Functor-≡' : (F G : Functor) 247 | -> fst (fst funct≃Σ F) ≡ fst (fst funct≃Σ G) 248 | -> F ≡ G 249 | -- Functor-≡' F G h = ≡-on-≃ funct≃Σ (Σ-prop-≡ (λ { (x , y) → functIsProp x y}) h) 250 | 251 | postulate 252 | functIsSet : isStrictCategory C -> isSet Functor 253 | -- functIsSet k = 254 | -- subst isSet (sym (ua funct≃Σ)) 255 | -- (Σ-subset (Σ-set {!!} {!!}) (λ { (o , m) → functIsProp {!!} {!!} })) 256 | 257 | module _ (F G : Functor) where 258 | open Functor 259 | 260 | apF0 : (x : _) -> F ≡ G -> (F ₀) x ≡ (G ₀) x 261 | apF0 x p = ap (_$ x) (ap _₀ p) 262 | 263 | RawNatTrans : Set _ 264 | RawNatTrans = (c : Obj C) → Morph D ((F ₀) c) ((G ₀) c) 265 | 266 | isNatural : RawNatTrans → Set _ 267 | isNatural ϕ = ∀{C₁ C₂} (f : Morph C C₁ C₂) 268 | → _∘_ D ((G ₁) f) (ϕ C₁) ≡ _∘_ D (ϕ C₂) ((F ₁) f) 269 | 270 | natrltyIsProp : (ϕ : RawNatTrans) -> isProp (isNatural ϕ) 271 | natrltyIsProp ϕ h h' = 272 | funExt' _ $ λ _ → funExt' _ λ _ → funExt _ $ λ x → hom-set D _ _ (h x) (h' x) 273 | 274 | NatTrans : Set _ 275 | NatTrans = Σ RawNatTrans isNatural 276 | 277 | ≡-nt : (ϕ ψ : NatTrans) -> fst ϕ ≡ fst ψ -> ϕ ≡ ψ 278 | ≡-nt ϕ ψ p = Σ-prop-≡ natrltyIsProp p 279 | 280 | IdNatTrans : {F : Functor} → NatTrans F F 281 | IdNatTrans {F} = (λ c → id ((F ₀) c)) , λ f → 282 | ∘id ((F ₁) f) · sym (id∘ ((F ₁) f)) 283 | where open Functor ; open Category D 284 | 285 | [_,_] : Category 286 | [_,_] = record 287 | { Obj = Functor 288 | ; Morph = λ F G → NatTrans F G 289 | ; _∘_ = λ {I} {J} {K} ϕ ψ → (λ c → fst ϕ c ∘ fst ψ c) , 290 | λ {C₁} f → sym (∘∘ ((K ₁) f) (fst ϕ _) (fst ψ _)) 291 | · cong (_∘ fst ψ C₁) (snd ϕ _) 292 | · ∘∘ (fst ϕ _) ((J ₁) f) (fst ψ _) 293 | · cong (fst ϕ _ ∘_) (snd ψ _) 294 | · sym (∘∘ _ _ _) 295 | ; id = λ F → IdNatTrans {F} 296 | ; ∘∘ = λ {I} {_} {_} {L} f g h → 297 | ≡-nt I L _ _ (funExt _ λ x → ∘∘ (fst f x) (fst g x) (fst h x)) 298 | ; id∘ = λ {I} {J} f → ≡-nt I J _ _ (funExt _ (λ x → id∘ (fst f x))) 299 | ; ∘id = λ {I} {J} f → ≡-nt I J _ _ (funExt _ (λ x → ∘id (fst f x))) 300 | ; hom-set = λ {F} {G} → Σ-subset (Π-set λ x → hom-set) (natrltyIsProp F G) 301 | } 302 | where open Category D ; open Functor 303 | 304 | module _ {l l' l'' l'''} {C : Category {l} {l'}} {D : Category {l''} {l'''}} where 305 | 306 | open Functor 307 | open Category 308 | open FunctorEq 309 | 310 | Functor-≡ : {F G : Functor C D} 311 | -> FunctorEq C D (F ₀) (λ _ _ -> F ₁) (G ₀) (λ _ _ -> G ₁) 312 | -> F ≡ G 313 | Functor-≡ {F} {G} eq = 314 | Functor-≡' _ _ _ _ (Σ-≡ (funExt _ (eq0 eq) , 315 | funeq-lemma C D {F ₀} {G ₀} (funExt _ (eq0 eq)) (eq1 eq))) 316 | 317 | FunctorEq-refl : (F : Functor C D) -> FunctorEq C D (F ₀) (λ _ _ -> F ₁) (F ₀) (λ _ _ -> F ₁) 318 | FunctorEq-refl F = 319 | record { eq0 = λ x → refl 320 | ; eq1 = λ f → transpRefl _ _ · transpRefl _ ((F ₁) f) } 321 | 322 | Functor-≡-prop : (F G : Functor C D) 323 | -> ((a b : Obj D) → isProp (Morph D a b)) 324 | -> F ₀ ≡ G ₀ 325 | -> F ≡ G 326 | Functor-≡-prop F G h p = Functor-≡ -- F G 327 | (record { eq0 = λ x → ap (_$ x) p ; eq1 = λ f → h _ _ _ _ }) 328 | 329 | module _ {la la' lb lb' lc lc' ld ld'} 330 | {A : Category {la} {la'}} 331 | {B : Category {lb} {lb'}} 332 | {C : Category {lc} {lc'}} 333 | {D : Category {ld} {ld'}} 334 | (F : Functor A B) (G : Functor C D) 335 | where 336 | 337 | open Category 338 | open Functor 339 | 340 | cross-fun : Functor (cross A C) (cross B D) 341 | _₀ cross-fun (a , c) = (F ₀ $ a) , (G ₀ $ c) 342 | _₁ cross-fun (f , g) = (F ₁ $ f) , (G ₁ $ g) 343 | fid cross-fun (x , y) = cong2 _,_ (fid F x) (fid G y) 344 | f∘ cross-fun (f1 , f2) (g1 , g2) = cong2 _,_ (f∘ F f1 g1) (f∘ G f2 g2) 345 | 346 | Sets : ∀{l} → Category 347 | Sets {l} = record 348 | { Obj = Σ (Set l) isSet -- Set l 349 | ; Morph = λ A B → fst A → fst B 350 | ; _∘_ = λ z z₁ z₂ → z (z₁ z₂) 351 | ; id = λ _ x → x 352 | ; ∘∘ = λ _ _ _ → refl 353 | ; id∘ = λ _ → refl 354 | ; ∘id = λ _ → refl 355 | ; hom-set = λ {a} {b} → →-set (snd a) (snd b) 356 | } 357 | 358 | module _ {l} {l'} (C : Category {l} {l'}) where 359 | 360 | IdFunctor : Functor C C 361 | IdFunctor = MkFunct (λ x → x) (λ x → x) (λ _ → refl) (λ _ _ → refl) 362 | 363 | open Category 364 | 365 | ConstFunctor : ∀{dl dl'} (D : Category {dl} {dl'}) (c : Obj C) 366 | -> Functor D C 367 | ConstFunctor D c = 368 | MkFunct (λ _ → c) (λ _ → id C c) (λ _ → refl) λ _ _ → sym $ id∘ C _ 369 | 370 | module _ {lc} {lc'} {ld} {ld'} {le} {le'} 371 | {C : Category {lc} {lc'}} 372 | {D : Category {ld} {ld'}} 373 | {E : Category {le} {le'}} where 374 | 375 | open Functor 376 | open Category 377 | 378 | compFun : (F : Functor C D) (G : Functor D E) → Functor C E 379 | _₀ (compFun F G) x = (G ₀) ((F ₀) x) 380 | _₁ (compFun F G) f = (G ₁) ((F ₁) f) 381 | fid (compFun F G) x = cong (G ₁) (fid F x) · fid G ((F ₀) x) 382 | f∘ (compFun F G) f g = ap (G ₁) (f∘ F f g) · f∘ G (F ₁ $ f) (F ₁ $ g) 383 | 384 | module _ {l l' l''} (C : Category {l} {l'}) where 385 | 386 | open Category C 387 | open Functor 388 | 389 | PSh : Set _ 390 | PSh = Functor (C ᵒᵖ) (Sets {l''}) 391 | 392 | PShCat : Category 393 | PShCat = [ C ᵒᵖ , Sets {l''} ] 394 | 395 | -- open import Function using (_$_) 396 | 397 | -- module Elements (cStrictCat : isStrictCategory C) where 398 | 399 | -- ∫ : PSh → Category 400 | -- Obj (∫ P) = Σ Obj (λ A → fst ((P ₀) A)) 401 | -- Morph (∫ P) (J , γ') (I , γ) = Σ (Morph J I) (λ u → (P ₁) u γ ≡ γ') 402 | -- _∘_ (∫ P) {I} {J} {K} (u , p) (u' , p') = 403 | -- (u ∘ u') , cong (_$ snd K) (f∘ P u' u) · cong ((P ₁) u') p · p' 404 | 405 | -- id (∫ P) x = id (fst x) , cong (_$ snd x) (fid P (fst x)) 406 | -- ∘∘ (∫ P) f g h = Σ-prop-≡ (λ x → snd ((P ₀) (fst _)) _ _) (∘∘ (fst f) (fst g) (fst h)) 407 | -- id∘ (∫ P) = λ f → Σ-prop-≡ {!!} (id∘ (fst f)) 408 | -- ∘id (∫ P) = λ f → Σ-prop-≡ {!!} (∘id (fst f)) 409 | -- hom-set (∫ P) {a1 , a2} {b1 , b2} = Σ-set hom-set λ u → {!!} 410 | 411 | -- uhm : {P Q : PSh} 412 | -- → Functor ((∫ Q) ᵒᵖ) (Sets {l''}) → NatTrans (C ᵒᵖ) (Sets {l''}) P Q 413 | -- → Functor ((∫ P) ᵒᵖ) (Sets {l''}) 414 | -- _₀ (uhm A ϕ) (I , γ) = (A ₀) (I , fst ϕ I γ) 415 | -- _₁ (uhm A ϕ) {a = (I , γ)} (u , p) x = 416 | -- (A ₁) (u , cong (_$ γ) (snd ϕ u) · cong (fst ϕ _) p) x 417 | -- fid (uhm A ϕ) x = funExt _ (λ y → {!!}) -- fid A >>= λ f → ∣ (λ _ → f _) ∣ 418 | -- f∘ (uhm A ϕ) = {!!} 419 | -- -- do 420 | -- -- fA <- f∘ A 421 | -- -- ∣ (λ {i} {j} {k} f g → 422 | -- -- fA (fst' f , cong (_$ snd j) <$> snd' ϕ (fst' f) ● cong (fst' ϕ (fst k)) <$> snd' f) 423 | -- -- (fst' g , cong (_$ snd i) <$> snd' ϕ (fst' g) ● cong (fst' ϕ (proj₁ j)) <$> snd' g)) ∣ 424 | 425 | record HasTerminalObj {l l'} (C : Category {l} {l'}) : Set (l ⊔ l') where 426 | open Category C 427 | field 428 | one : Obj 429 | bang : (x : Obj) → Morph x one 430 | uniq : (x : Obj) → (f : Morph x one) → f ≡ bang x 431 | -- (one' : Obj) → ((x : Obj) → Morph x one') → _≃_ {C = C} one one' 432 | 433 | module _ where 434 | open HasTerminalObj 435 | 436 | terminalSets : ∀{l} → HasTerminalObj (Sets {l}) 437 | one terminalSets = ⊤ , ⊤-is-set 438 | bang terminalSets = λ _ _ → tt 439 | uniq terminalSets = λ x f → refl 440 | 441 | module CatCategory {l} (strct : (C : Category {l} {l}) -> isStrictCategory C) where 442 | 443 | Cat : Category 444 | Cat = record 445 | { Obj = Category {l} {l} 446 | ; Morph = Functor 447 | ; id = IdFunctor 448 | ; _∘_ = λ F G → compFun G F 449 | ; hom-set = λ {C} {D} -> functIsSet _ _ (strct C) 450 | ; id∘ = λ {C} {D} F → Functor-≡ (FunctorEq-refl F) 451 | ; ∘id = λ {C} {D} F → Functor-≡ (FunctorEq-refl F) 452 | ; ∘∘ = λ F G H → Functor-≡ (FunctorEq-refl (compFun H (compFun G F))) 453 | } 454 | 455 | open Functor 456 | open Category 457 | 458 | op-functor : Functor Cat Cat 459 | (op-functor ₀) C = C ᵒᵖ 460 | (op-functor ₁) {C} {D} F = MkFunct (F ₀) (F ₁) (fid F) λ f g → f∘ F g f 461 | fid op-functor C = 462 | Functor-≡ (record { eq0 = λ _ → refl 463 | ; eq1 = λ _ → transpRefl _ _ · transpRefl _ _ }) 464 | f∘ op-functor f g = 465 | Functor-≡ (record { eq0 = λ _ → refl 466 | ; eq1 = λ _ → transpRefl _ _ · transpRefl _ _ }) 467 | -------------------------------------------------------------------------------- /GroupoidModel/Basics.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --allow-unsolved-metas #-} 2 | 3 | module GroupoidModel.Basics where 4 | 5 | open import Utils 6 | open import Function using (_$_) 7 | open import CategoryTheory 8 | open import Data.Product 9 | open import Cubical.Core.Prelude 10 | open import Agda.Primitive using (_⊔_) 11 | 12 | open import GroupoidModel.Groupoid 13 | open Groupoid 14 | 15 | module _ {l} where 16 | 17 | Ty : (Γ : Groupoid {l}) → Set _ 18 | Ty Γ = cat Γ ⟶ Grpd {l} 19 | 20 | module _ (Γ : Groupoid) (A : Ty Γ) where 21 | 22 | open Category 23 | open Functor 24 | 25 | fmp0 : ∀ γ γ' → GMorph Γ γ γ' 26 | → Obj (cat ((A ₀) γ)) → GObj ((A ₀) γ') 27 | fmp0 _ _ p = ((A ₁) p) ₀ 28 | 29 | fmp0-id : ∀{γ} (x : _) → fmp0 _ _ (gid Γ γ) x ≡ x 30 | fmp0-id {γ} x = cong (_$ x) ((cong (_₀) (fid A γ))) 31 | 32 | fmp : ∀ {γ γ'} → GMorph Γ γ γ' → GrpdFunctor ((A ₀) γ) ((A ₀) γ') 33 | fmp p = ((A ₁) p) 34 | 35 | fmp0∘ : ∀{γ γ' γ''} (p : GMorph Γ γ γ') (q : GMorph Γ γ' γ'') (x : GObj ((A ₀) γ)) 36 | -> fmp0 _ _ q (fmp0 _ _ p x) ≡ fmp0 _ _ (_∘_ (cat Γ) q p) x 37 | fmp0∘ p q x = sym $ ap (_$ x) $ ap _₀ $ f∘ A q p 38 | where open Category (cat Γ) 39 | 40 | record Tm (Γ : Groupoid) (A : Ty Γ) : Set l where 41 | no-eta-equality 42 | constructor MkTm 43 | open Category 44 | open Functor 45 | 46 | field 47 | _₀' : (γ : Obj (cat Γ)) → Obj (cat ((A ₀) γ)) 48 | _₁' : ∀{γ γ'} → (p : GMorph Γ γ γ') 49 | → GMorph ((A ₀) γ') (fmp0 Γ A γ γ' p (_₀' γ)) (_₀' γ') 50 | fid' : ∀ γ → PathOver {C = cat (A ₀ $ γ)} 51 | (_₁' (gid Γ γ)) (fmp0-id Γ A (γ ₀')) (gid ((A ₀) γ) (_₀' γ)) 52 | f∘' : ∀{γ γ' γ''} → (p : GMorph Γ γ γ') (p' : GMorph Γ γ' γ'') 53 | → PathOver {C = cat ((A ₀) γ'')} 54 | (_₁' (_∘_ (cat Γ) p' p)) 55 | (cong (_$ γ ₀') (cong _₀ (f∘ A p' p))) 56 | (_∘_ (cat ((A ₀) γ'')) (_₁' p') (((fmp Γ A p') ₁) (_₁' p))) 57 | 58 | module _ {l} where 59 | 60 | _,,_ : (Γ : Groupoid {l}) → Ty {l} Γ → Groupoid {l} 61 | cat (g@(record { cat = Γ}) ,, A) = record 62 | { Obj = Σ (Obj Γ) λ γ → Obj (cat ((A ₀) γ)) 63 | ; Morph = λ { (γ , x) (γ' , x') → Σ (Morph Γ γ γ') λ p → Morph (cat ((A ₀) γ')) (fmp0 g A _ _ p x) x' } 64 | ; id = λ { (γ , x) → id Γ γ , substMorph {C = cat ((A ₀) γ)} (sym (cong (_$ x) (cong _₀ (fid A γ)))) (id (cat ((A ₀) γ)) x) } 65 | ; _∘_ = λ { {γ , x} {γ' , x'} {γ'' , x''} (p' , q') (p , q) 66 | → _∘_ Γ p' p , _∘_ (cat ((A ₀) γ'')) q' (substMorph {C = (cat ((A ₀) γ''))} 67 | (sym (ap (_$ x) $ ap _₀ $ f∘ A p' p)) 68 | ((((A ₁) p') ₁) q)) } 69 | ; hom-set = {!!} 70 | ; id∘ = λ { (p , q) → Σ-≡ (id∘ Γ p , {!!}) } 71 | ; ∘id = {!!} 72 | ; ∘∘ = {!!} 73 | } 74 | where open Category ; open Functor 75 | grpd (Γ ,, A) f = {!!} 76 | strct (Γ ,, A) = {!!} 77 | 78 | -- module _ {l} {Γ : Groupoid {l}} {A : Ty {l} Γ} where 79 | 80 | -- open Functor 81 | 82 | -- p : cat (Γ ,, A) ⟶ cat Γ 83 | -- (p ₀) (γ , x) = γ 84 | -- (p ₁) (p , q) = p 85 | -- fid p = {!!} 86 | -- f∘ p = {!!} 87 | 88 | module _ {l} (Γ : Groupoid {l}) {Δ : Groupoid {l}} {A : Ty {l} Δ} where 89 | 90 | π₁ : cat Γ ⟶ cat (Δ ,, A) → cat Γ ⟶ cat Δ 91 | π₁ σ = 92 | MkFunct (λ x → fst ((σ ₀) x)) 93 | (λ f → fst ((σ ₁) f)) 94 | (λ x → cong fst (fid σ x)) 95 | (λ f g → cong fst (f∘ σ f g)) 96 | where open Functor ; open Category 97 | 98 | module _ {l} (Γ : Groupoid {l}) (A : Ty {l} Γ) (a : Tm Γ A) where 99 | 100 | open Functor 101 | open Tm 102 | 103 | ,,fun : GrpdFunctor Γ (Γ ,, A) 104 | (,,fun ₀) γ = γ , (a ₀' $ γ) 105 | (,,fun ₁) p = p , (a ₁' $ p) 106 | fid ,,fun γ = {!!} 107 | f∘ ,,fun p q = {!!} 108 | 109 | module _ {l} -- (H : (A : Groupoid {l}) -> Functor (cat (gcross A A)) (Grpd {l})) 110 | (Γ : Groupoid {l}) (A : Ty {l} Γ) where 111 | 112 | open Functor 113 | open Category 114 | 115 | tms-fst : GrpdFunctor (Γ ,, A) Γ 116 | tms-fst = π₁ {l} (Γ ,, A) {Γ} {A} (IdFunctor (cat (Γ ,, A))) 117 | 118 | rearrange : GrpdFunctor ((Γ ,, A) ,, compFun tms-fst A) 119 | (gcross (Γ ,, A) (Γ ,, A)) 120 | (rearrange ₀) ((γ , x) , y) = (γ , x) , (γ , y) 121 | (rearrange ₁) ((p , q1) , q2) = (p , q1) , (p , q2) 122 | fid rearrange ((γ , x) , y) = Σ-≡ ((Σ-≡ (refl , transpRefl _ _)) , 123 | Σ-≡ (transpRefl _ _ , {!!})) 124 | f∘ rearrange ((p , q1) , q2) ((p' , q1') , q2') = {!!} 125 | 126 | 127 | -- uncurry,, : Ty {l} ((Γ ,, A) ,, compFun tms-fst A) 128 | -- (uncurry,, ₀) ((γ , x) , y) = (H ((A ₀) γ)) ₀ $ x , y 129 | -- (uncurry,, ₁) {(γ , x) , y} {(γ' , x') , y'} ((p , q1) , q2) = 130 | -- let aux = (H ((A ₀) γ') ₁) (q1 , q2) in compFun {!!} aux 131 | -- fid uncurry,, = {!!} 132 | -- f∘ uncurry,, = {!!} 133 | 134 | open import Function using (flip) 135 | 136 | _[_] : ∀{l}{Γ Δ : Groupoid {l}} -> Ty Γ → cat Δ ⟶ cat Γ -> Ty Δ 137 | _[_] = flip compFun 138 | 139 | module _ {l} {Γ Δ : Groupoid {l}} {A : Ty Δ} where 140 | 141 | open Tm 142 | open Functor 143 | -- open Category 144 | 145 | _[_]' : Tm Δ A -> (σ : cat Γ ⟶ cat Δ) -> Tm Γ (compFun σ A) 146 | (M [ f ]' ₀') γ = (M ₀') (f ₀ $ γ) 147 | (M [ f ]' ₁') p = (M ₁') (f ₁ $ p) 148 | fid' (M [ f ]') γ = substPathOver (strct ((A ₀) ((f ₀) γ))) _ goal' 149 | where 150 | aux = compPathOver (symPathOver (fid' M ((f ₀) γ))) (fid' M (f ₀ $ γ)) 151 | aux' = MkPathOver (let xxx = ap (M ₁') (fid f γ) in fromPathP xxx) 152 | goal' = compPathOver aux' (compPathOver (fid' M ((f ₀) γ)) aux) 153 | f∘' (M [ f ]') {γ'' = γ''} p p' = 154 | substPathOver (strct ((A ₀) ((f ₀) γ''))) _ 155 | (compPathOver (MkPathOver (fromPathP (ap (M ₁') (f∘ f p' p)))) 156 | (f∘' M ((f ₁) p) ((f ₁) p'))) 157 | 158 | π₂ : (σ : cat Γ ⟶ cat (Δ ,, A)) → Tm Γ (compFun (π₁ {l} Γ {Δ} {A} σ) A) 159 | (π₂ σ ₀') γ = snd ((σ ₀) γ) 160 | (π₂ σ ₁') p = snd ((σ ₁) p) 161 | fid' (π₂ σ) γ = substPathOver (strct ((A ₀) (proj₁ ((σ ₀) γ)))) _ 162 | (compPathOver (MkPathOver (fromPathP (ap snd (fid σ γ)))) collapsePathOver) 163 | f∘' (π₂ σ) {γ'' = γ''} p q = {!!} -- substPathOver {!!} _ {!!} 164 | -- (compPathOver (MkPathOver (fromPathP (ap snd (f∘ σ q p)))) {!!}) 165 | where open Category (cat ((A ₀) (proj₁ ((σ ₀) γ'')))) 166 | 167 | _,s_ : (σ : GrpdFunctor Γ Δ) → Tm Γ (compFun σ A) → GrpdFunctor Γ (Δ ,, A) 168 | ((σ ,s t) ₀) γ = (σ ₀ $ γ) , (t ₀' $ γ) 169 | ((σ ,s t) ₁) p = (σ ₁ $ p) , (t ₁' $ p) 170 | fid (σ ,s t) γ = Σ-≡ (fid σ γ , {!!}) 171 | f∘ (σ ,s t) f g = Σ-≡ (f∘ σ f g , {!!}) 172 | -------------------------------------------------------------------------------- /GroupoidModel/Groupoid.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --allow-unsolved-metas #-} 2 | 3 | module GroupoidModel.Groupoid where 4 | 5 | open import Function using (const ; _$_) 6 | open import Utils 7 | open import Cubical.Core.Prelude 8 | open import CategoryTheory 9 | open import Agda.Primitive using (lsuc ; _⊔_) 10 | 11 | module _ {l} where 12 | 13 | isGroupoid : (C : Category {l} {l}) → Set _ 14 | isGroupoid C = ∀{a b} → (f : Morph a b) → isIso C f 15 | where open Category C 16 | 17 | record Groupoid : Set (lsuc l) where 18 | -- no-eta-equality 19 | field 20 | cat : Category {l} {l} 21 | strct : isStrictCategory cat 22 | grpd : isGroupoid cat 23 | 24 | open Groupoid 25 | 26 | module _ where 27 | open Category 28 | GObj : Groupoid -> Set l 29 | GObj G = Obj (cat G) 30 | 31 | GMorph : (G : Groupoid) -> GObj G -> GObj G -> Set l 32 | GMorph G x y = Morph (cat G) x y 33 | 34 | gid : (G : Groupoid) (x : GObj G) -> GMorph G x x 35 | gid G x = id (cat G) x 36 | 37 | sym-gid : (G : Groupoid) (x : GObj G) -> fst (grpd G (gid G x)) ≡ gid G x 38 | sym-gid G x = 39 | inverseUnique (cat G) (gid G x) (fst gr) (gid G x) 40 | (snd gr) (id∘ (id x) , id∘ (id x)) 41 | where open Category (cat G) 42 | gr = (grpd G (gid G x)) 43 | 44 | module _ {l} (G : Groupoid {l}) where 45 | 46 | open Groupoid 47 | 48 | liftedIsGroupoid : isGroupoid (Lift (cat G)) 49 | liftedIsGroupoid (MkWrap f) = 50 | MkWrap (fst (grpd G f)) , 51 | Wrap-≡ (fst (snd (grpd G f))) , 52 | Wrap-≡ (snd (snd (grpd G f))) 53 | 54 | LiftGrpd : Groupoid {lsuc l} 55 | LiftGrpd = record { cat = Lift (cat G) 56 | ; strct = liftStrict (cat G) (strct G) 57 | ; grpd = liftedIsGroupoid } 58 | 59 | module _ {l} (A : Set l) (aset : isSet A) where 60 | 61 | -- discrete groupoid 62 | Δgrpd : Groupoid {l} 63 | Δgrpd = record { cat = Δ A aset ; strct = aset _ _ 64 | ; grpd = λ f → sym f , aset _ _ _ _ , aset _ _ _ _ } 65 | 66 | module _ {l} (G H : Groupoid {l}) where 67 | 68 | open Groupoid 69 | 70 | gcross : Groupoid {l} 71 | cat gcross = cross (cat G) (cat H) 72 | strct gcross {a} {b} = 73 | level2-is-set (Σ-level 2 74 | (set-is-level2 (λ x y → strct G {x} {y})) λ _ → 75 | set-is-level2 λ x y → strct H {x} {y}) a b 76 | grpd gcross (f , g) = (fst (grpd G f) , fst (grpd H g)) , 77 | ×-≡ (fst (snd (grpd G f))) (fst (snd (grpd H g))) , 78 | ×-≡ (snd (snd (grpd G f))) (snd (snd (grpd H g))) 79 | 80 | module _ {l1 l2} where 81 | 82 | open Groupoid 83 | 84 | GrpdFunctor : (G : Groupoid {l1}) (H : Groupoid {l2}) → Set _ 85 | GrpdFunctor G H = cat G ⟶ cat H 86 | 87 | module _ {l} where 88 | 89 | open Groupoid 90 | open Functor 91 | open Category 92 | 93 | Grpd : Category 94 | Grpd = record 95 | { Obj = Groupoid {l} 96 | ; Morph = GrpdFunctor 97 | ; id = λ G → IdFunctor (cat G) 98 | ; _∘_ = λ F G → compFun G F 99 | ; id∘ = λ {I} {J} F → Functor-≡ (FunctorEq-refl F) 100 | ; ∘id = λ {I} {J} F → Functor-≡ (FunctorEq-refl F) 101 | ; ∘∘ = λ {I} {J} {K} {L} F G H → Functor-≡ (FunctorEq-refl (compFun H (compFun G F))) 102 | ; hom-set = λ {G} {H} → functIsSet (cat G) (cat H) (strct G) 103 | } 104 | 105 | module _ {l} where 106 | 107 | open Functor 108 | open Wrap 109 | 110 | gliftFunctor : Functor (Grpd {l}) (Grpd {lsuc l}) 111 | (gliftFunctor ₀) G = LiftGrpd G 112 | (gliftFunctor ₁) {G} {H} F = 113 | MkFunct (λ x → MkWrap ((F ₀) (unWrap x))) 114 | (λ f → MkWrap ((F ₁) (unWrap f))) 115 | (λ x → Wrap-≡ (fid F (unWrap x))) 116 | (λ f g → Wrap-≡ (f∘ F (unWrap f) (unWrap g))) 117 | fid gliftFunctor G = 118 | Functor-≡ (record { eq0 = λ x → refl 119 | ; eq1 = λ f → transpRefl _ _ · transpRefl _ _ }) 120 | f∘ gliftFunctor = {!!} 121 | 122 | module _ {l} {l'} {C : Category {l} {l'}} {a b c : Category.Obj C} where 123 | open Category 124 | 125 | -- record MorphOver (C : Category {l} {l'}) (a b c : Obj C) : Set (l ⊔ l') where 126 | -- field 127 | -- pp : a ≡ b 128 | -- mm : Morph C a c 129 | -- getmm : Morph C b c 130 | -- getmm = subst (λ z → Morph C z _) pp mm 131 | 132 | substMorph : -- {C : Category {l} {l'}} {a b c : Category.Obj C} 133 | a ≡ b -> Morph C a c -> Morph C b c 134 | substMorph p u = subst (λ z → Morph C z _) p u 135 | 136 | data PathOver (u : Morph C a c) (p : a ≡ b) (v : Morph C b c) : Set l' where 137 | MkPathOver : substMorph p u ≡ v -> PathOver u p v 138 | 139 | getPathOver : {u : Morph C a c} {p : a ≡ b} {v : Morph C b c} 140 | -> PathOver u p v -> substMorph p u ≡ v 141 | getPathOver (MkPathOver x) = x 142 | 143 | module _ {l} {l'} {C : Category {l} {l'}} where 144 | open Category 145 | 146 | module _ {a b c d : Category.Obj C} 147 | {p : a ≡ b} {u : Category.Morph C a d} {v : Category.Morph C b d} 148 | {q : b ≡ c} {w : Category.Morph C c d} 149 | where 150 | 151 | compPathOver : PathOver {C = C} u p v -> PathOver {C = C} v q w 152 | -> PathOver {C = C} u (p · q) w 153 | compPathOver (MkPathOver x) (MkPathOver y) = {!!} 154 | -- MkPathOver (subst· p q {!!} · ap (substMorph q) x · y) 155 | -- r (MkPathOver x) = 156 | -- MkPathOver {!!} -- (sym (ap (substMorph q) r) · x) 157 | 158 | module _ {a b c : Category.Obj C} 159 | {p : a ≡ b} {u : Category.Morph C a c} {v : Category.Morph C b c} 160 | where 161 | 162 | symPathOver : PathOver {C = C} u p v -> PathOver {C = C} v (sym p) u 163 | symPathOver (MkPathOver x) = {!!} 164 | -- MkPathOver (sym (ap (substMorph (sym p)) x) · subst· (sym p) p u · {!!}) 165 | 166 | module _ {a b : Obj C} {u v : Morph C a b} where 167 | overRefl : u ≡ v -> PathOver {C = C} u refl v 168 | overRefl p = MkPathOver (transpRefl _ _ · p) 169 | 170 | module _ {a b c : Obj C} {u : Category.Morph C a c} {v : Category.Morph C b c} {p : a ≡ b} 171 | (strctCat : isStrictCategory C) where 172 | 173 | substPathOver : (q : a ≡ b) -> PathOver {C = C} u p v -> PathOver {C = C} u q v 174 | substPathOver q x = subst (λ z → PathOver u z v) {p} {q} (strctCat p q) x 175 | 176 | -- module _ {a b c d : Obj C} {u : Category.Morph C a d} {v : Category.Morph C c d} {p : b ≡ c} {q : a ≡ b} where 177 | 178 | -- collapsePathOver : PathOver {C = C} (substMorph {C = C} q u) p v -> PathOver {C = C} u (q · p) v 179 | -- collapsePathOver = {!!} 180 | 181 | module _ {a b c : Obj C} {u : Morph C a c} {q : a ≡ b} where 182 | collapsePathOver : PathOver {C = C} (substMorph {C = C} q u) (sym q) u 183 | collapsePathOver = MkPathOver {!!} 184 | 185 | module _ {l} {l'} where 186 | open Groupoid 187 | open Functor 188 | open Category 189 | 190 | g-id : (G : Groupoid {l}) {x y : Obj (cat G)} (A : cat G ⟶ Grpd {l'}) (p : Morph (cat G) x y) (a : _) 191 | -> Morph (cat ((A ₀) y)) ((((A ₁) p) ₀) ((((A ₁) (fst (grpd G p))) ₀) a)) a 192 | g-id G {x} {y} A p a = 193 | substMorph {C = C} (sym ((apF0 _ _ _ _ a $ ap (A ₁) $ snd (snd (grpd G p))) · apF0 _ _ _ _ a (fid A y)) · apF0 _ _ _ _ a (f∘ A p p-1)) (id C a) 194 | where p-1 = (fst (grpd G p)) 195 | C = cat ((A ₀) y) 196 | 197 | -------------------------------------------------------------------------------- /GroupoidModel/IdTypes.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --allow-unsolved-metas #-} 2 | 3 | module GroupoidModel.IdTypes where 4 | 5 | open import Cubical.Core.Prelude 6 | open import CategoryTheory 7 | open import GroupoidModel.Groupoid 8 | open import GroupoidModel.Basics 9 | open import Agda.Primitive 10 | open import Function using (_$_) 11 | open import Utils 12 | 13 | module _ {l} (A : Groupoid {l}) where 14 | 15 | open Functor 16 | open Groupoid 17 | open Tm 18 | 19 | dupl : Functor (cat A) (cross (cat A) (cat A)) 20 | (dupl ₀) x = x , x 21 | (dupl ₁) f = f , f 22 | fid dupl a = refl 23 | f∘ dupl f g = refl 24 | 25 | module _ where 26 | open Category (cat A) 27 | 28 | Id : Functor (cat (gcross A A)) (Grpd {l}) -- (cat Gpd) 29 | (Id ₀) (a1 , a2) = Δgrpd (Morph a1 a2) hom-set 30 | (Id ₁) {a = a1 , a2} {b = b1 , b2} (p1 , p2) = 31 | MkFunct (λ q → p2 ∘ (q ∘ fst (grpd A p1))) 32 | (ap (λ a → p2 ∘ (a ∘ fst (grpd A p1)))) 33 | (λ x → hom-set _ _ _ _) λ f g → hom-set _ _ _ _ 34 | fid Id (a1 , a2) = 35 | Functor-≡-prop _ _ hom-set 36 | (funExt _ λ q → ap (λ z → id a2 ∘ (q ∘ z)) (sym-gid A a1) 37 | · id∘ (q ∘ id a1) · ∘id q) 38 | f∘ Id (f , g) (f' , g') = 39 | Functor-≡-prop _ _ hom-set (funExt _ goal) 40 | where 41 | subgoal1 : ((fst (grpd A f') ∘ fst (grpd A f)) ∘ (f ∘ f')) ≡ id _ 42 | subgoal1 = {!!} 43 | subgoal2 : ((f ∘ f') ∘ (fst (grpd A f') ∘ fst (grpd A f))) ≡ id _ 44 | subgoal2 = {!!} 45 | goal : (q : _) -> ((g ∘ g') ∘ (q ∘ fst (grpd A (f ∘ f')))) 46 | ≡ (g ∘ ((g' ∘ (q ∘ fst (grpd A f'))) ∘ fst (grpd A f))) 47 | goal q = begin 48 | ((g ∘ g') ∘ (q ∘ fst (grpd A (f ∘ f')))) 49 | ≡⟨ {!!} ⟩ 50 | (((g ∘ g') ∘ q) ∘ fst (grpd A (f ∘ f'))) 51 | ≡⟨ ap (((g ∘ g') ∘ q) ∘_) (inverseUnique (cat A) (f ∘ f') _ _ 52 | (snd (grpd A (f ∘ f'))) (subgoal1 , subgoal2)) ⟩ 53 | ((((g ∘ g') ∘ q) ∘ (fst (grpd A f') ∘ fst (grpd A f)))) 54 | ≡⟨ {!!} ⟩ 55 | (g ∘ ((g' ∘ (q ∘ fst (grpd A f'))) ∘ fst (grpd A f))) 56 | ∎ 57 | 58 | refl-ctor : Tm A (compFun dupl Id) 59 | (refl-ctor ₀') a = gid A a 60 | (refl-ctor ₁') p = ap (p ∘_) (id∘ _) · snd (snd (grpd A p)) 61 | fid' refl-ctor γ = {!!} -- hom-set _ _ _ _ 62 | f∘' refl-ctor _ _ = {!!} -- hom-set _ _ _ _ 63 | 64 | refl-fun : Functor (cat A) (cat (gcross A A ,, Id)) 65 | (refl-fun ₀) x = (x , x) , (refl-ctor ₀' $ x) 66 | (refl-fun ₁) f = (f , f) , (refl-ctor ₁' $ f) 67 | fid refl-fun x = Σ-≡ (refl , hom-set _ _ _ _) 68 | f∘ refl-fun f g = Σ-≡ (refl , hom-set _ _ _ _) 69 | 70 | module _ (C : Functor (cat (gcross A A ,, Id)) (Grpd {l})) 71 | (h : Tm A (compFun refl-fun C)) where 72 | 73 | J-elim : Tm (gcross A A ,, Id) C 74 | (J-elim ₀') ((a1 , a2) , r) = (((C ₁) (((gid A a1) , r) , aux)) ₀) (h ₀' $ a1) 75 | where 76 | open Category (cat A) 77 | aux : (r ∘ (id a1 ∘ fst (grpd A (id a1)))) ≡ r 78 | aux = ap (r ∘_) (snd (snd (grpd A (id a1)))) · ∘id r 79 | (J-elim ₁') {(a1 , a2) , r} {(a1' , a2') , r'} ((p₁ , p₂) , q) = goal 80 | where 81 | p₁⁻¹ = fst (grpd A p₁) 82 | _∘×_ = Category._∘_ (cat (gcross A A ,, Id)) 83 | 84 | C1 : ∀{a b} -> Category.Morph (cat (gcross A A ,, Id)) a b 85 | -> Functor (cat ((C ₀) a)) (cat ((C ₀) b)) 86 | C1 p = (C ₁) p -- unFunctor' (fst ((C ₁) p)) 87 | 88 | goalGrpd = (C ₀ $ (a1' , a2') , r') 89 | 90 | h1p1 = (h ₁') p₁ 91 | 92 | open Category (cat A) 93 | 94 | z : GMorph (gcross A A ,, Id) ((a1' , a1') , (refl-ctor ₀' $ a1')) ((a1' , a2') , r') 95 | z = (gid A a1' , r') , ap (_∘_ r') (snd $ snd (grpd A (gid A a1'))) · ∘id r' 96 | 97 | C1z : GMorph goalGrpd 98 | (C1 z ₀ $ C1 ((p₁ , p₁) , _) ₀ $ h ₀' $ a1) 99 | (((C1 ((gid A a1' , r') , _)) ₀) (h ₀' $ a1')) 100 | C1z = C1 z ₁ $ h1p1 101 | 102 | aux : (p₂ ∘ r) ∘ (id a1 ∘ fst (grpd A p₁)) ≡ r' 103 | aux = (ap (_∘_ (p₂ ∘ r)) (id∘ _) 104 | · ∘∘ p₂ r _ · q · (sym $ ∘id r') 105 | · ap (_∘_ r') (sym $ snd $ snd (grpd A (gid A a1')))) 106 | · ap (_∘_ r') (snd $ snd (grpd A (gid A a1'))) 107 | · ∘id r' 108 | 109 | prf : (C1 ((p₁ , p₂ ∘ r) , aux) ₀ $ h ₀' $ a1) 110 | ≡ (C1 z ₀ $ C1 ((p₁ , p₁) , _) ₀ $ h ₀' $ a1) 111 | prf = ap (λ w → (C1 w) ₀ $ (h ₀') a1) eq · (ap (_$ (h ₀' $ a1)) $ ap _₀ (f∘ C z ((p₁ , p₁) , _))) 112 | where 113 | q' : p₂ ∘ r ≡ r' ∘ p₁ 114 | q' = ap (p₂ ∘_) (sym (∘∘ r p₁⁻¹ p₁ · (ap (r ∘_) (fst (snd (grpd A p₁))) 115 | · ∘id r))) · sym (∘∘ p₂ (r ∘ p₁⁻¹) p₁) · ap (_∘ p₁) q 116 | eq : ((p₁ , p₂ ∘ r) , aux) 117 | ≡ (_∘×_ z ((p₁ , p₁) , (refl-ctor ₁') p₁)) 118 | eq = Σ-prop-≡ (λ x → hom-set _ _) (×-≡ (sym (id∘ p₁)) q') 119 | 120 | goal' : GMorph goalGrpd 121 | (C1 ((p₁ , p₂ ∘ r) , _) ₀ $ h ₀' $ a1) 122 | (((C1 ((gid A a1' , r') , _)) ₀) (h ₀' $ a1')) 123 | goal' = substMorph {C = cat goalGrpd} (sym prf) C1z 124 | 125 | prf2 : ((C1 ((p₁ , p₂ ∘ r) , aux) ₀) $ (h ₀') $ a1) 126 | ≡ ((C1 ((p₁ , p₂) , q) ₀) $ (C1 ((gid A a1 , r) , _) ₀) $ (h ₀') $ a1) 127 | prf2 = {!!} · (ap (_$ (h ₀' $ a1)) $ ap _₀ (f∘ C ((p₁ , p₂) , q) ((gid A a1 , r) , _))) 128 | 129 | goal : GMorph goalGrpd 130 | (C1 ((p₁ , p₂) , q) ₀ $ C1 (((gid A a1) , r) , _) ₀ $ h ₀' $ a1) 131 | (((C1 ((gid A a1' , r') , _)) ₀) (h ₀' $ a1')) 132 | goal = substMorph {C = cat goalGrpd} prf2 goal' 133 | fid' J-elim _ = {!!} 134 | f∘' J-elim = {!!} 135 | 136 | module _ {l} (Γ : Groupoid {l}) (A : Ty Γ) where 137 | 138 | open Groupoid 139 | 140 | IdType : Ty ((Γ ,, A) ,, compFun (π₁ (Γ ,, A) (IdFunctor (cat (Γ ,, A)))) A) 141 | IdType = compFun (rearrange Γ A) (Id (Γ ,, A)) 142 | -------------------------------------------------------------------------------- /GroupoidModel/Model.agda: -------------------------------------------------------------------------------- 1 | module GroupoidModel.Model {l} where 2 | 3 | open import GroupoidModel.Groupoid 4 | open import GroupoidModel.Basics 5 | open import Utils 6 | open import GroupoidModel.PiTypes 7 | open import GroupoidModel.IdTypes 8 | open import Model 9 | open import CategoryTheory 10 | open import Cubical.Core.Prelude 11 | open import Agda.Primitive 12 | 13 | open Model.Model 14 | open Groupoid 15 | open import GroupoidModel.Universe {l} 16 | 17 | Con = Groupoid {lsuc l} 18 | Tms = GrpdFunctor {lsuc l} {lsuc l} 19 | 20 | grpdModel : Model {lsuc (lsuc l)} {lsuc (lsuc l)} {lsuc l} {lsuc l} 21 | Conᴹ grpdModel = Groupoid {lsuc l} 22 | Tmsᴹ grpdModel = GrpdFunctor {lsuc l} {lsuc l} 23 | Tyᴹ grpdModel Γ = cat Γ ⟶ Grpd {lsuc l} 24 | Tmᴹ grpdModel Γ A = Tm Γ A 25 | _,ᴹ_ grpdModel Γ A = Γ ,, A 26 | π₁ᴹ grpdModel {Γᴹ = Γ} σ = π₁ Γ σ 27 | _[_]ᴹ grpdModel A f = compFun f A 28 | _[_]'ᴹ grpdModel = _[_]' 29 | _,sᴹ_ grpdModel = _,s_ 30 | π₂ᴹ grpdModel {Γᴹ = Δ} {Γ} {Aᴹ = A} σ = π₂ σ 31 | ◇ᴹ grpdModel = 32 | record { cat = ⊤-cat ; strct = λ _ _ → refl ; grpd = λ f → tt , refl , refl } 33 | idᴹ grpdModel Γᴹ = IdFunctor (cat Γᴹ) 34 | εᴹ grpdModel = MkFunct (λ _ → tt) (λ _ → tt) (λ _ → refl) λ _ _ → refl 35 | εηᴹ grpdModel = 36 | Functor-≡' _ _ _ _ 37 | (record { eq0 = λ _ → refl ; eq1 = λ f → transpRefl _ _ · transpRefl _ _ }) 38 | _∘ᴹ_ grpdModel F G = compFun G F 39 | [id]ᴹ grpdModel Aᴹ = Functor-≡' _ _ _ _ (FunctorEq-refl _ _ Aᴹ) 40 | [][]ᴹ grpdModel {σᴹ = σ} {τ} {A} = Functor-≡' _ _ _ _ (FunctorEq-refl _ _ (compFun τ (compFun σ A))) 41 | id∘ᴹ grpdModel {σᴹ = σ} = Functor-≡' _ _ _ _ (FunctorEq-refl _ _ σ) 42 | ∘idᴹ grpdModel {σᴹ = σ} = Functor-≡' _ _ _ _ (FunctorEq-refl _ _ σ) 43 | ∘∘ᴹ grpdModel {σᴹ = σ} {τ} {δ} = Functor-≡' _ _ _ _ (FunctorEq-refl _ _ (compFun δ (compFun τ σ))) 44 | π₁βᴹ grpdModel = Functor-≡' _ _ _ _ (record { eq0 = λ x → refl ; eq1 = λ f → transpRefl _ _ · transpRefl _ _ }) 45 | π₂βᴹ grpdModel = {!!} 46 | πηᴹ grpdModel = {!!} 47 | ,∘₁ᴹ grpdModel = {!!} 48 | ,∘₂ᴹ grpdModel = {!!} 49 | Uᴹ grpdModel = ConstFunctor _ _ Gpd 50 | U[]ᴹ grpdModel σ = Functor-≡' _ _ _ _ 51 | (record { eq0 = λ _ → refl ; eq1 = λ f → transpRefl _ _ · transpRefl _ _ }) 52 | Πᴹ grpdModel A B = Π A B 53 | Π[]ᴹ grpdModel A B σ = {!!} 54 | Elᴹ grpdModel A = El A 55 | El[]ᴹ grpdModel A σ = {!!} 56 | lamᴹ grpdModel t = lam _ _ t 57 | appᴹ grpdModel t = app _ _ t 58 | βᴹ grpdModel t = {!!} 59 | ηᴹ grpdModel f = {!!} 60 | Idᴹ grpdModel {Γ = Γ} A = IdType Γ A 61 | -- lam[]ᴹ grpdModel t σ = {!!} 62 | -- ty-trunc grpdModel = {!!} 63 | -------------------------------------------------------------------------------- /GroupoidModel/PiTypes.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical #-} 2 | {-# OPTIONS --allow-unsolved-metas #-} 3 | 4 | module GroupoidModel.PiTypes where 5 | 6 | open import Utils 7 | open import Function using (_$_) 8 | open import Model 9 | open import CategoryTheory 10 | open import Data.Product 11 | open import Cubical.Core.Prelude 12 | open import GroupoidModel.Groupoid 13 | open import GroupoidModel.Basics 14 | 15 | open Functor 16 | open Groupoid 17 | open Category 18 | open Tm 19 | open import IdUtils 20 | 21 | postulate 22 | swap-pathover : ∀{l l'} {A : Set l} (B : A -> Set l') {a b : A} 23 | -> (p : a ≡ b) (u : B a) (v : B b) 24 | -> subst B p u ≡ v -> u ≡ subst B (sym p) v 25 | 26 | module _ {l} where 27 | 28 | _◂ : ∀{Γ} {A : Ty {l} Γ} → Tm Γ A → GrpdFunctor Γ (Γ ,, A) 29 | _₀ (M ◂) γ = γ , (M ₀') γ 30 | _₁ (M ◂) p = p , (M ₁') p 31 | fid (_◂ {Γ} {A} M) x = ap (id (cat Γ) x ,_) goal' 32 | where 33 | open Category (cat Γ) 34 | D = λ z → Category.Morph (cat ((A ₀) x)) z ((M ₀') x) 35 | prf = cong (_$ ((M ₀') x)) (cong _₀ (fid A x)) 36 | goal' = swap-pathover D prf _ _ (getPathOver (fid' M x)) 37 | f∘ (_◂ {Γ} M) f g = Σ-≡ (refl , {!!}) -- ap ((f ∘ g) ,_) {!f∘' M g f!} 38 | where open Category (cat Γ) 39 | 40 | Tmᴳ : ∀{Γ} (A : Ty Γ) → Groupoid 41 | cat (Tmᴳ {Γ} A) = 42 | record 43 | { Obj = Tm Γ A 44 | ; Morph = λ M N 45 | → Σ ((γ : Obj (cat Γ)) → Morph (cat ((A ₀) γ)) ((M ₀') γ) ((N ₀') γ)) λ τ 46 | → isNatural _ _ (M ◂) (N ◂) (λ γ → id (cat Γ) _ , 47 | subst (λ z → Morph (cat ((A ₀) γ)) z ((N ₀') γ)) 48 | (sym (cong (_$ _) $ cong _₀ $ fid A γ)) 49 | (τ γ)) 50 | ; id = λ M → (λ γ → id (cat ((A ₀) γ)) ((M ₀') γ)) , λ f → {!!} 51 | ; _∘_ = {!!} 52 | ; hom-set = {!!} 53 | ; id∘ = {!!} 54 | ; ∘id = {!!} 55 | ; ∘∘ = {!!} 56 | } 57 | grpd (Tmᴳ A) = {!!} 58 | strct (Tmᴳ A) = {!!} 59 | 60 | module _ {Γ} (A : Ty {l} Γ) (B : Ty {l} (Γ ,, A)) where 61 | 62 | Π' : (γ : Obj (cat Γ)) → Ty ((A ₀) γ) 63 | _₀ (Π' γ) x = (B ₀) (γ , x) 64 | _₁ (Π' γ) p = 65 | (B ₁) (id (cat Γ) γ , 66 | subst (λ z → Morph (cat ((A ₀) γ)) z _) 67 | (sym (cong (_$ _) (cong _₀ (fid A γ)))) p) 68 | fid (Π' γ) x = 69 | cong (B ₁) (Σ-≡ (refl , transpRefl (Morph (cat ((A ₀) γ)) _ _) _)) · fid B (γ , x) 70 | f∘ (Π' γ) f g = Functor-≡' _ _ _ _ {!!} -- Functor-≡ {!!} {!!} {!!} {!!} {!!} 71 | 72 | auxM : ∀{γ γ'} (p : Morph (cat Γ) γ γ') 73 | -> Tm ((A ₀) γ) (Π' γ) -> Tm ((A ₀) γ') (Π' γ') 74 | _₀' (auxM {γ} {γ'} p M) a = (((B ₁) (p , id')) ₀) ((M ₀') (((A ₁) p⁻¹ ₀) a)) 75 | where p⁻¹ = fst (grpd Γ p) 76 | C = cat ((A ₀) γ') 77 | id' = substMorph {C = C} (sym ((apF0 _ _ _ _ a $ ap (A ₁) $ snd (snd (grpd Γ p))) · apF0 _ _ _ _ a (fid A γ')) · ap (_$ a) (ap _₀ (f∘ A p p⁻¹))) (id C a) 78 | _₁' (auxM {γ} {γ'} p M) {a} {a'} q = 79 | substMorph {C = (cat ((B ₀) (γ' , a')))} goal aux' 80 | where 81 | p⁻¹ = fst (grpd Γ p) 82 | aux = (M ₁') ((((A ₁) p⁻¹) ₁) q) 83 | id' = g-id Γ A p a' 84 | aux' = (((B ₁) (p , id')) ₁) aux 85 | goal : ((B ₁) (p , id') ₀) ((((Π' γ) ₁) (((A ₁) p⁻¹ ₁) q) ₀) ((M ₀') (((A ₁) p⁻¹ ₀) a))) 86 | ≡ ((((Π' γ') ₁) q) ₀) (((B ₁) (p , _) ₀) ((M ₀') (((A ₁) p⁻¹ ₀) a))) 87 | goal = {!!} 88 | fid' (auxM {γ} {γ'} p M) = {!!} 89 | f∘' (auxM {γ} {γ'} p M) = {!!} 90 | 91 | auxM→ : ∀{γ γ'} (M M' : Tm ((A ₀) γ) (Π' γ)) 92 | -> Morph (cat (Tmᴳ (Π' γ))) M M' 93 | -> (p : Morph (cat Γ) γ γ') 94 | -> Morph (cat (Tmᴳ (Π' γ'))) (auxM p M) (auxM p M') 95 | fst (auxM→ {γ} {γ'} M M' (τ , isNat) p) a = 96 | (((B ₁) (p , g-id Γ A p a)) ₁) (τ (fmp0 Γ A _ _ p⁻¹ a)) 97 | where 98 | p⁻¹ = fst (grpd Γ p) 99 | snd (auxM→ M M' (τ , isNat) p) f = {!!} 100 | 101 | Π : Ty Γ 102 | _₀ Π γ = Tmᴳ {(A ₀) γ} (Π' γ) 103 | _₁ Π {γ} {γ'} p = F 104 | where 105 | F : GrpdFunctor (Tmᴳ (Π' _)) (Tmᴳ (Π' _)) 106 | _₀ F = auxM p 107 | _₁ F {M} {M'} τ = auxM→ M M' τ p 108 | fid F = {!!} 109 | f∘ F = {!!} 110 | fid Π = {!!} 111 | f∘ Π = {!!} 112 | 113 | module _ (M : Tm {l} (Γ ,, A) B) where 114 | 115 | lam₀ : (γ : Obj (cat Γ)) → Obj (cat ((Π ₀) γ)) 116 | lam₀ γ = 117 | MkTm (λ x → (M ₀') (γ , x)) 118 | (λ u → (M ₁') (id (cat Γ) γ , subst (λ z → 119 | Morph (cat ((A ₀) γ)) z _) (sym (cong (_$ _) $ cong _₀ (fid A γ))) u)) 120 | {!!} {!!} 121 | 122 | lam₁ : ∀{γ γ'} → (p : Morph (cat Γ) γ γ') 123 | → Morph (cat $ (Π ₀) γ') (((Π ₁) p ₀) (lam₀ γ)) (lam₀ γ') 124 | lam₁ {γ} {γ'} p = τ , {!!} 125 | where 126 | τ : (x' : Obj $ cat $ (A ₀) γ') 127 | → Morph (cat $ (B ₀) (γ' , x')) 128 | ((((((Π ₁) p) ₀) (lam₀ γ)) ₀') x') 129 | (((lam₀ γ') ₀') x') 130 | τ x' = (M ₁') (p , g-id Γ A p x') 131 | 132 | lam : Tm Γ Π 133 | _₀' lam = lam₀ 134 | _₁' lam = lam₁ 135 | fid' lam = {!!} 136 | f∘' lam = {!!} 137 | 138 | module _ (M : Tm {l} Γ Π) where 139 | 140 | app : Tm (Γ ,, A) B 141 | _₀' app (γ , x) = (((M ₀') γ) ₀') x 142 | _₁' app {γ , x} {γ' , x'} (p , q) = _∘_ (cat ((B ₀) (γ' , x'))) aux aux'''' 143 | where 144 | p⁻¹ = fst (grpd Γ p) 145 | q' : Morph (cat ((A ₀) γ')) (((A ₁) (id (cat Γ) γ') ₀) (fmp0 Γ A _ _ p x)) x' 146 | q' = substMorph {C = cat ((A ₀) γ')} (sym $ ap (_$ (fmp0 Γ A γ γ' p x)) $ ap _₀ (fid A γ')) q 147 | p· = fmp0 Γ A _ _ p 148 | p⁻¹· = fmp0 Γ A _ _ p⁻¹ 149 | p·' = fmp0 Γ Π _ _ p 150 | p-id· = fmp0 (Γ ,, A) B _ _ (p , (id (cat (A ₀ $ γ')) (p· x))) 151 | id-q· = fmp0 (Γ ,, A) B _ _ (id (cat Γ) γ' , q') 152 | p-q· = fmp0 (Γ ,, A) B _ _ (p , q) 153 | p-id·' = fmp0 (Γ ,, A) B _ _ (p , g-id Γ A p (p· x)) 154 | 155 | aux : Morph (cat $ (B ₀) (γ' , x')) 156 | (id-q· ((((M ₀') γ') ₀') (p· x))) 157 | (((M ₀') γ' ₀') x') 158 | aux = (((M ₀') γ') ₁') q 159 | 160 | aux' : Morph (cat ((B ₀) (γ' , p· x))) 161 | (((p·' ((M ₀') γ)) ₀') (p· x)) 162 | (((M ₀') γ' ₀') (p· x)) 163 | aux' = fst ((M ₁') p) (p· x) 164 | 165 | aux'' : Morph (cat ((B ₀) (γ' , p· x))) 166 | (p-id· ((M ₀' $ γ) ₀' $ x)) 167 | ((((M ₀') γ' ₀') (p· x))) 168 | aux'' = substMorph {C = cat ((B ₀) (γ' , p· x))} goal aux' 169 | where 170 | goal : (p·' ((M ₀') γ) ₀') (p· x) ≡ p-id· ((((M ₀') $ γ) ₀') $ x) 171 | goal = begin 172 | p-id·' ((M ₀' $ γ) ₀' $ p⁻¹· (p· x)) 173 | ≡⟨ {!!} ⟩ 174 | p-id· ((M ₀' $ γ) ₀' $ x) 175 | ∎ 176 | 177 | aux''' : Morph (cat $ (B ₀) (γ' , x')) 178 | (id-q· (p-id· ((M ₀' $ γ) ₀' $ x))) 179 | (id-q· ((M ₀' $ γ') ₀' $ p· x)) 180 | aux''' = (B ₁ $ (id (cat Γ) γ') , q') ₁ $ aux'' 181 | 182 | aux'''' : Morph (cat $ (B ₀) (γ' , x')) 183 | (p-q· ((M ₀' $ γ) ₀' $ x)) 184 | (id-q· ((M ₀' $ γ') ₀' $ p· x)) 185 | aux'''' = substMorph {C = cat $ (B ₀) (γ' , x')} goal aux''' 186 | where 187 | fmpAB = fmp0 (Γ ,, A) B 188 | postulate goal : id-q· (p-id· ((((M ₀') $ γ) ₀') $ x)) ≡ p-q· ((((M ₀') $ γ) ₀') $ x) 189 | -- goal = begin 190 | -- fmpAB _ _ (id (cat Γ) γ' , q') (fmpAB _ _ (p , id (cat (A ₀ $ γ')) (p· x)) ((((M ₀') $ γ) ₀') $ x)) 191 | -- ≡⟨ fmp0∘ (Γ ,, A) B (p , (id (cat (A ₀ $ γ')) (p· x))) (id (cat Γ) γ' , q') ((((M ₀') $ γ) ₀') $ x) ⟩ 192 | -- fmpAB _ _ (_∘_ (cat (Γ ,, A)) (id (cat Γ) γ' , q') (p , (id (cat (A ₀ $ γ')) (p· x)))) ((((M ₀') $ γ) ₀') $ x) 193 | -- ≡⟨ {!!} ⟩ 194 | -- {!!} 195 | fid' app = {!!} 196 | f∘' app = {!!} 197 | -------------------------------------------------------------------------------- /GroupoidModel/Universe.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --allow-unsolved-metas #-} 2 | 3 | module GroupoidModel.Universe {l} where 4 | 5 | open import Cubical.Core.Prelude 6 | open import CategoryTheory 7 | open import GroupoidModel.Groupoid 8 | open Category 9 | open Groupoid 10 | open import GroupoidModel.Basics 11 | 12 | open import Agda.Primitive 13 | 14 | Cat : Category {lsuc l} {lsuc l} 15 | Obj Cat = Category {l} {l} 16 | Morph Cat C D = Functor' C D 17 | id Cat I₁ = {!!} 18 | (Cat ∘ x) x₁ = {!!} 19 | hom-set Cat x y x₁ y₁ = {!!} 20 | id∘ Cat f = {!!} 21 | ∘id Cat f = {!!} 22 | ∘∘ Cat f g h = {!!} 23 | 24 | open import Utils 25 | 26 | GpdCat : Category {lsuc l} {lsuc l} 27 | Obj GpdCat = Groupoid {l} -- {l} 28 | Morph GpdCat G H = Σ (Functor' (cat G) (cat H)) (isIso Cat) 29 | id GpdCat G = MkFunctor' (IdFunctor (cat G)) , {!!} 30 | _∘_ GpdCat (MkFunctor' F , isoF) (MkFunctor' G , isoG) = 31 | MkFunctor' (compFun G F) , {!!} 32 | hom-set GpdCat (MkFunctor' F , isoF) (MkFunctor' G , isoG) p q = {!!} 33 | id∘ GpdCat (MkFunctor' f , isoF) = Σ-prop-≡ (λ F → {!!}) (ap MkFunctor' (Functor-≡ (FunctorEq-refl f))) 34 | ∘id GpdCat f = {!!} 35 | ∘∘ GpdCat f g h = {!!} 36 | 37 | Gpd : Groupoid {lsuc l} -- {lsuc l} 38 | Gpd = record { cat = GpdCat ; strct = {!!} ; grpd = {!!} } 39 | 40 | module _ where 41 | open Functor 42 | open Functor' 43 | 44 | forgetIsos : Functor GpdCat (Grpd {l}) 45 | (forgetIsos ₀) G = G 46 | (forgetIsos ₁) f = unFunctor' (fst f) 47 | fid forgetIsos _ = refl 48 | f∘ forgetIsos _ _ = refl 49 | 50 | incl : Functor GpdCat (Grpd {lsuc l}) 51 | incl = compFun forgetIsos gliftFunctor 52 | 53 | module _ {Γ : Groupoid {lsuc l}} where 54 | 55 | Univ : Ty Γ 56 | Univ = ConstFunctor _ _ Gpd 57 | 58 | open Functor 59 | open Tm 60 | 61 | El' : Tm Γ Univ -> Functor (cat Γ) GpdCat 62 | (El' A ₀) γ = (A ₀') γ 63 | (El' A ₁) p = (A ₁') p 64 | fid (El' A) γ = {!!} 65 | f∘ (El' A) = {!!} 66 | 67 | El : Tm Γ Univ -> Ty Γ 68 | El A = compFun (El' A) incl 69 | -------------------------------------------------------------------------------- /Model.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical #-} 2 | {-# OPTIONS --no-termination-check #-} 3 | 4 | module Model where 5 | 6 | open import Utils 7 | 8 | open import Cubical.Core.Prelude 9 | open import Agda.Primitive 10 | open import Syntax 11 | 12 | -- Model of type theory as a CwF 13 | record Model {l} {l'} {l''} {l'''} : Set (lsuc (l ⊔ l' ⊔ l'' ⊔ l''')) where 14 | field 15 | Conᴹ : Set l -- (lsuc l) 16 | Tyᴹ : Conᴹ → Set l' -- (lsuc l) 17 | Tmsᴹ : Conᴹ → Conᴹ → Set l'' 18 | Tmᴹ : (Γᴹ : Conᴹ) → Tyᴹ Γᴹ → Set l''' 19 | 20 | ◇ᴹ : Conᴹ 21 | _,ᴹ_ : (Γᴹ : Conᴹ) → Tyᴹ Γᴹ → Conᴹ 22 | _[_]ᴹ : {Θᴹ Γᴹ : Conᴹ} → Tyᴹ Θᴹ → Tmsᴹ Γᴹ Θᴹ → Tyᴹ Γᴹ 23 | idᴹ : (Γᴹ : Conᴹ) → Tmsᴹ Γᴹ Γᴹ 24 | 25 | -- the empty context is the terminal object 26 | εᴹ : ∀{Γᴹ} → Tmsᴹ Γᴹ ◇ᴹ 27 | εηᴹ : ∀{Γᴹ} {σᴹ : Tmsᴹ Γᴹ ◇ᴹ} → σᴹ ≡ εᴹ 28 | 29 | _∘ᴹ_ : ∀{Θᴹ Γᴹ Δᴹ} → Tmsᴹ Θᴹ Δᴹ → Tmsᴹ Γᴹ Θᴹ → Tmsᴹ Γᴹ Δᴹ 30 | [id]ᴹ : {Γᴹ : Conᴹ} → (Aᴹ : Tyᴹ Γᴹ) → Aᴹ [ idᴹ Γᴹ ]ᴹ ≡ Aᴹ 31 | [][]ᴹ : ∀{Θᴹ Γᴹ Δᴹ} {σᴹ : Tmsᴹ Θᴹ Δᴹ} {τᴹ : Tmsᴹ Γᴹ Θᴹ} {Aᴹ : Tyᴹ Δᴹ} 32 | → Aᴹ [ σᴹ ]ᴹ [ τᴹ ]ᴹ ≡ Aᴹ [ σᴹ ∘ᴹ τᴹ ]ᴹ 33 | 34 | -- category laws for substitutions 35 | id∘ᴹ : ∀{Γᴹ Δᴹ} → {σᴹ : Tmsᴹ Γᴹ Δᴹ} → idᴹ _ ∘ᴹ σᴹ ≡ σᴹ 36 | ∘idᴹ : ∀{Γᴹ Δᴹ} → {σᴹ : Tmsᴹ Γᴹ Δᴹ} → σᴹ ∘ᴹ idᴹ _ ≡ σᴹ 37 | ∘∘ᴹ : ∀{Θᴹ Γᴹ Δᴹ ∇ᴹ} {σᴹ : Tmsᴹ Δᴹ ∇ᴹ} {τᴹ : Tmsᴹ Γᴹ Δᴹ} {δᴹ : Tmsᴹ Θᴹ Γᴹ} 38 | → (σᴹ ∘ᴹ τᴹ) ∘ᴹ δᴹ ≡ σᴹ ∘ᴹ (τᴹ ∘ᴹ δᴹ) 39 | 40 | -- substitution extension 41 | _,sᴹ_ : ∀{Γᴹ Δᴹ} {Aᴹ : Tyᴹ Δᴹ} → (σᴹ : Tmsᴹ Γᴹ Δᴹ) → Tmᴹ Γᴹ (Aᴹ [ σᴹ ]ᴹ) 42 | → Tmsᴹ Γᴹ (Δᴹ ,ᴹ Aᴹ) 43 | π₁ᴹ : ∀{Γᴹ Δᴹ} {Aᴹ : Tyᴹ Δᴹ} → Tmsᴹ Γᴹ (Δᴹ ,ᴹ Aᴹ) → Tmsᴹ Γᴹ Δᴹ 44 | π₂ᴹ : ∀{Γᴹ Δᴹ} {Aᴹ : Tyᴹ Δᴹ} → (σᴹ : Tmsᴹ Γᴹ (Δᴹ ,ᴹ Aᴹ)) → Tmᴹ Γᴹ (Aᴹ [ π₁ᴹ σᴹ ]ᴹ) 45 | π₁βᴹ : ∀{Γᴹ Δᴹ} {σᴹ : Tmsᴹ Γᴹ Δᴹ} {Aᴹ : Tyᴹ Δᴹ} {tᴹ : Tmᴹ Γᴹ (Aᴹ [ σᴹ ]ᴹ)} 46 | → π₁ᴹ (σᴹ ,sᴹ tᴹ) ≡ σᴹ 47 | π₂βᴹ : ∀{Γᴹ Δᴹ} {σᴹ : Tmsᴹ Γᴹ Δᴹ} {Aᴹ : Tyᴹ Δᴹ} {tᴹ : Tmᴹ Γᴹ (Aᴹ [ σᴹ ]ᴹ)} 48 | -- → subst (Tmᴹ Γᴹ) (cong (λ x → Aᴹ [ x ]ᴹ) π₁βᴹ) (π₂ᴹ (σᴹ ,sᴹ tᴹ)) ≡ tᴹ 49 | → PathP (λ i → Tmᴹ Γᴹ (Aᴹ [ π₁βᴹ {σᴹ = σᴹ} {tᴹ = tᴹ} i ]ᴹ)) (π₂ᴹ (σᴹ ,sᴹ tᴹ)) tᴹ 50 | 51 | πηᴹ : ∀{Γᴹ Δᴹ} {Aᴹ : Tyᴹ Δᴹ} {σᴹ : Tmsᴹ Γᴹ (Δᴹ ,ᴹ Aᴹ)} 52 | → (π₁ᴹ σᴹ ,sᴹ π₂ᴹ σᴹ) ≡ σᴹ 53 | 54 | _[_]'ᴹ : ∀{Γᴹ Δᴹ} {Aᴹ : Tyᴹ Δᴹ} → Tmᴹ Δᴹ Aᴹ → (σᴹ : Tmsᴹ Γᴹ Δᴹ) 55 | → Tmᴹ Γᴹ (Aᴹ [ σᴹ ]ᴹ) 56 | 57 | -- ,∘ᴹ : ∀{Γᴹ Δᴹ ∇ᴹ} {τᴹ : Tmsᴹ Γᴹ Δᴹ} {σᴹ : Tmsᴹ ∇ᴹ Γᴹ} 58 | -- → {Aᴹ : Tyᴹ Δᴹ} {tᴹ : Tmᴹ Γᴹ (Aᴹ [ τᴹ ]ᴹ)} 59 | -- → _≡_ {A = Tmsᴹ ∇ᴹ (Δᴹ ,ᴹ Aᴹ)} 60 | -- ((τᴹ ,sᴹ tᴹ) ∘ᴹ σᴹ) 61 | -- ((τᴹ ∘ᴹ σᴹ) ,sᴹ subst (Tmᴹ ∇ᴹ) [][]ᴹ (tᴹ [ σᴹ ]'ᴹ)) 62 | 63 | ,∘₁ᴹ : ∀{Γᴹ Δᴹ ∇ᴹ} {τᴹ : Tmsᴹ Γᴹ Δᴹ} {σᴹ : Tmsᴹ ∇ᴹ Γᴹ} {Aᴹ : Tyᴹ Δᴹ} 64 | → {tᴹ : Tmᴹ Γᴹ (Aᴹ [ τᴹ ]ᴹ)} 65 | → π₁ᴹ ((τᴹ ,sᴹ tᴹ) ∘ᴹ σᴹ) ≡ (τᴹ ∘ᴹ σᴹ) 66 | 67 | -- _[_]'∘ᴹ : ∀{Γᴹ Δᴹ ∇ᴹ} {Aᴹ : Tyᴹ ∇ᴹ} {τᴹ : Tmsᴹ Δᴹ ∇ᴹ} 68 | -- → Tmᴹ Δᴹ (Aᴹ [ τᴹ ]ᴹ) → (σᴹ : Tmsᴹ Γᴹ Δᴹ) → Tmᴹ Γᴹ (Aᴹ [ τᴹ ∘ᴹ σᴹ ]ᴹ) 69 | -- [][]∘ᴹ : ∀{Γᴹ Δᴹ ∇ᴹ} {Aᴹ : Tyᴹ ∇ᴹ} {τᴹ : Tmsᴹ Δᴹ ∇ᴹ} 70 | -- → (tᴹ : Tmᴹ Δᴹ (Aᴹ [ τᴹ ]ᴹ)) → (σᴹ : Tmsᴹ Γᴹ Δᴹ) 71 | -- → PathP (λ i → Tmᴹ Γᴹ ([][]ᴹ {σᴹ = τᴹ} {σᴹ} {Aᴹ} i)) (tᴹ [ σᴹ ]'ᴹ) (tᴹ [ σᴹ ]'∘ᴹ) 72 | 73 | -- ,∘₂ᴹ : ∀{Γᴹ Δᴹ ∇ᴹ} {τᴹ : Tmsᴹ Γᴹ Δᴹ} {σᴹ : Tmsᴹ ∇ᴹ Γᴹ} {Aᴹ : Tyᴹ Δᴹ} 74 | -- → {tᴹ : Tmᴹ Γᴹ (Aᴹ [ τᴹ ]ᴹ)} 75 | -- → PathP (λ i → Tmᴹ ∇ᴹ (Aᴹ [ ,∘₁ᴹ {τᴹ = τᴹ} {σᴹ} {Aᴹ} {tᴹ} i ]ᴹ)) 76 | -- (π₂ᴹ ((τᴹ ,sᴹ tᴹ) ∘ᴹ σᴹ)) 77 | -- (tᴹ [ σᴹ ]'∘ᴹ) 78 | 79 | ,∘₂ᴹ : ∀{Γ Δ ∇} {τ : Tmsᴹ Γ Δ} {σ : Tmsᴹ ∇ Γ} {A : Tyᴹ Δ} {t : Tmᴹ Γ (A [ τ ]ᴹ)} 80 | → subst (Tmᴹ ∇) 81 | (cong (λ x → A [ x ]ᴹ) ,∘₁ᴹ · sym [][]ᴹ) 82 | (π₂ᴹ ((τ ,sᴹ t) ∘ᴹ σ)) 83 | ≡ (t [ σ ]'ᴹ) 84 | 85 | -- π₂∘ᴹ : ∀{Γ Δ ∇} {A : Tyᴹ ∇} → {τ : Tmsᴹ Δ ∇} 86 | -- → (σ : Tmsᴹ Γ (Δ ,ᴹ (A [ τ ]ᴹ))) 87 | -- → Tmᴹ Γ (A [ τ ∘ᴹ π₁ᴹ σ ]ᴹ) 88 | -- π₂≡ᴹ : ∀{Γ Δ ∇} {A : Tyᴹ ∇} → {τ : Tmsᴹ Δ ∇} 89 | -- → (σ : Tmsᴹ Γ (Δ ,ᴹ (A [ τ ]ᴹ))) 90 | -- → PathP (λ i → Tmᴹ Γ ([][]ᴹ {σᴹ = τ} {π₁ᴹ σ} {A} i)) (π₂ᴹ σ) (π₂∘ᴹ σ) 91 | 92 | Uᴹ : ∀{Γ} → Tyᴹ Γ 93 | U[]ᴹ : ∀{Δᴹ Γᴹ} (σᴹ : Tmsᴹ Γᴹ Δᴹ) → Uᴹ [ σᴹ ]ᴹ ≡ Uᴹ 94 | 95 | Πᴹ : ∀{Γ} (A : Tyᴹ Γ) (B : Tyᴹ (Γ ,ᴹ A)) → Tyᴹ Γ 96 | Π[]ᴹ : ∀{Γ Δ} (A : Tyᴹ Γ) (B : Tyᴹ (Γ ,ᴹ A)) → (σ : Tmsᴹ Δ Γ) 97 | -> let _↑ᴹ_ : ∀{Γ Δ} → (σ : Tmsᴹ Γ Δ) → (A : Tyᴹ Δ) → Tmsᴹ (Γ ,ᴹ (A [ σ ]ᴹ)) (Δ ,ᴹ A) 98 | σ ↑ᴹ A = (σ ∘ᴹ π₁ᴹ (idᴹ _)) ,sᴹ subst (Tmᴹ _) [][]ᴹ (π₂ᴹ (idᴹ (_ ,ᴹ (A [ σ ]ᴹ)))) 99 | in (Πᴹ A B) [ σ ]ᴹ ≡ Πᴹ (A [ σ ]ᴹ) (B [ σ ↑ᴹ A ]ᴹ) 100 | 101 | Elᴹ : ∀{Γ} → (A : Tmᴹ Γ Uᴹ) → Tyᴹ Γ 102 | 103 | El[]ᴹ : ∀{Γ Δ} → (A : Tmᴹ Γ Uᴹ) → (σ : Tmsᴹ Δ Γ) 104 | → ((Elᴹ A) [ σ ]ᴹ) ≡ Elᴹ (subst (Tmᴹ Δ) (U[]ᴹ σ) (A [ σ ]'ᴹ)) 105 | 106 | lamᴹ : ∀{Γ} {A : Tyᴹ Γ} {B : Tyᴹ (Γ ,ᴹ A)} → Tmᴹ (Γ ,ᴹ A) B → Tmᴹ Γ (Πᴹ A B) 107 | appᴹ : ∀{Γ} {A : Tyᴹ Γ} {B : Tyᴹ (Γ ,ᴹ A)} → Tmᴹ Γ (Πᴹ A B) → Tmᴹ (Γ ,ᴹ A) B 108 | βᴹ : ∀{Γ} {A : Tyᴹ Γ} {B : Tyᴹ (Γ ,ᴹ A)} (t : Tmᴹ (Γ ,ᴹ A) B) → appᴹ (lamᴹ t) ≡ t 109 | ηᴹ : ∀{Γ} {A : Tyᴹ Γ} {B : Tyᴹ (Γ ,ᴹ A)} (f : Tmᴹ Γ (Πᴹ A B)) → lamᴹ (appᴹ f) ≡ f 110 | 111 | lam[]ᴹ : ∀{Δ Γ} {A : Tyᴹ Γ} {B : Tyᴹ (Γ ,ᴹ A)} (t : Tmᴹ (Γ ,ᴹ A) B) (σ : Tmsᴹ Δ Γ) 112 | -> let _↑ᴹ_ : ∀{Γ Δ} → (σ : Tmsᴹ Γ Δ) → (A : Tyᴹ Δ) → Tmsᴹ (Γ ,ᴹ (A [ σ ]ᴹ)) (Δ ,ᴹ A) 113 | σ ↑ᴹ A = (σ ∘ᴹ π₁ᴹ (idᴹ _)) ,sᴹ subst (Tmᴹ _) [][]ᴹ (π₂ᴹ (idᴹ (_ ,ᴹ (A [ σ ]ᴹ)))) 114 | in ((lamᴹ t) [ σ ]'ᴹ) ≡ subst (Tmᴹ Δ) (sym (Π[]ᴹ A B σ)) (lamᴹ (t [ σ ↑ᴹ A ]'ᴹ)) 115 | 116 | Idᴹ : ∀{Γ} (A : Tyᴹ Γ) -> Tyᴹ ((Γ ,ᴹ A) ,ᴹ (A [ π₁ᴹ (idᴹ _) ]ᴹ)) 117 | -- reflᴹ : ∀{Γ} {A : Tyᴹ Γ} (a : Tmᴹ Γ A) 118 | -- -> Tmᴹ Γ (Idᴹ A [ (idᴹ _ ,sᴹ subst (Tmᴹ Γ) (sym ([id]ᴹ A)) a) ,sᴹ subst (Tmᴹ Γ) (sym ([][]ᴹ · (ap (λ z → A [ z ]ᴹ) {!!} · [id]ᴹ A))) a ]ᴹ) 119 | 120 | ty-trunc : ∀{Γ} -> isSet (Tyᴹ Γ) 121 | 122 | variable 123 | Θ Γ Δ : Con 124 | 125 | module _ {l l'} (A : Set l) (aset : isSet A) where 126 | 127 | K : (M : A) (C : M ≡ M -> Set l') -> C refl -> (loop : M ≡ M) -> C loop 128 | K M C h p = subst C (aset _ _ _ _) h 129 | 130 | module _ {l} {l'} {l''} {l'''} (M : Model {l} {l'} {l''} {l'''}) where 131 | open Model M 132 | 133 | mutual 134 | con : Con → Conᴹ 135 | con ◇ = ◇ᴹ 136 | con (Γ , A) = (con Γ) ,ᴹ (ty A) 137 | 138 | ty : Ty Γ → Tyᴹ (con Γ) 139 | ty (A [ x ]) = (ty A) [ tms x ]ᴹ 140 | ty ([id] Γ A i) = [id]-proof (ty A) i 141 | ty ([][] {σ = σ} {τ = τ} {A = A} i) = [][]-proof {σᴹ = tms σ} {tms τ} {ty A} i 142 | ty U = Uᴹ 143 | ty (U[] σ i) = U[]ᴹ (tms σ) i 144 | ty (Π A B) = Πᴹ (ty A) (ty B) 145 | ty (Π[] A B σ i) = Π[]-proof A B σ i 146 | ty (El A) = Elᴹ (tm A) 147 | ty (El[] A σ i) = El-proof σ A i 148 | 149 | tms : Tms Γ Δ → Tmsᴹ (con Γ) (con Δ) 150 | tms (id Γ) = idᴹ (con Γ) 151 | tms ε = εᴹ 152 | tms (x ∘ y) = tms x ∘ᴹ tms y 153 | tms (∘∘ {σ = σ} {τ} {δ} i) = ∘∘ᴹ {σᴹ = tms σ} {tms τ} {tms δ} i 154 | tms (id∘ {σ = σ} i) = id∘ᴹ {σᴹ = tms σ} i 155 | tms (∘id {σ = σ} i) = ∘idᴹ {σᴹ = tms σ} i 156 | tms (π₁ σ) = π₁ᴹ (tms σ) 157 | tms (εη {σ = σ} i) = εηᴹ {σᴹ = tms σ} i 158 | tms (_,_ σ t) = tms σ ,sᴹ tm t 159 | tms (π₁β {Γ = Γ} {σ = σ} {A} {t} i) = π₁βᴹ {σᴹ = tms σ} {ty A} {tm t} i 160 | tms (πη {Γ = Γ} {Δ = Δ} {A = A} {σ} i) = πη-proof {Aᴹ = ty A} {tms σ} i 161 | tms (,∘₁ {Γ = Γ} {Δ} {∇} {τ = τ} {σ} {A} {t} i) = 162 | ,∘₁-proof {τᴹ = tms τ} {tms σ} {ty A} {tm t} i 163 | 164 | tm : {A : Ty Γ} → Tm Γ A → Tmᴹ (con Γ) (ty A) 165 | tm (t [ σ ]') = tm t [ tms σ ]'ᴹ 166 | tm (π₂ σ) = π₂ᴹ (tms σ) 167 | tm (π₂β {σ = σ} {A} {t} i) = π₂β-proof {σᴹ = tms σ} {ty A} {tm t} i 168 | tm (,∘₂ {∇ = ∇} {τ = τ} {σ} {A} {t} i) = ,∘₂ᴹ-proof {∇ = ∇} {τ = τ} {σ} {A} {t} i 169 | tm (lam t) = lamᴹ (tm t) 170 | tm (app f) = appᴹ (tm f) 171 | tm (β t i) = βᴹ (tm t) i 172 | tm (η f i) = ηᴹ (tm f) i 173 | tm (lam[] {A = A} {B} t σ i) = lam[]-proof A B σ t i 174 | 175 | [id]-proof = [id]ᴹ 176 | [][]-proof = [][]ᴹ 177 | ,∘₁-proof = ,∘₁ᴹ 178 | ,∘₂-proof = ,∘₂ᴹ 179 | -- [][]∘-proof = [][]∘ᴹ 180 | π₂β-proof = π₂βᴹ 181 | πη-proof = πηᴹ 182 | -- π₂≡-proof = π₂≡ᴹ 183 | 184 | lamᴹsub : ∀{Γ Δ} (A : Tyᴹ _) (B : Tyᴹ _) (t : Tmᴹ (Γ ,ᴹ A) B) (σ : Tmsᴹ _ _) 185 | {γ τ : Tmsᴹ (Δ ,ᴹ (A [ σ ]ᴹ)) (Γ ,ᴹ A)} (p : γ ≡ τ) 186 | -> lamᴹ (t [ γ ]'ᴹ) ≡ subst (Tmᴹ _) (ap (λ z → Πᴹ _ (B [ z ]ᴹ)) (sym p)) (lamᴹ (t [ τ ]'ᴹ)) 187 | lamᴹsub {Γ} {Δ} A B t σ {γ} = 188 | J (λ τ' p' → lamᴹ (t [ γ ]'ᴹ) ≡ subst (Tmᴹ _) (ap (λ z → Πᴹ _ (B [ z ]ᴹ)) (sym p')) (lamᴹ (t [ τ' ]'ᴹ))) 189 | (sym (transpRefl (Tmᴹ _ (Πᴹ _ _)) (lamᴹ (t [ γ ]'ᴹ)))) 190 | 191 | swap-subst : ∀{Γ Ty1 Ty2} {t : Tm Γ Ty1} 192 | -> (p : Ty1 ≡ Ty2) (q : ty Ty1 ≡ ty Ty2) 193 | -> tm (subst (Tm Γ) p t) ≡ subst (Tmᴹ (con Γ)) q (tm t) 194 | swap-subst {Γ} {Ty1} {_} {t} = J (λ Ty2' p' → (q : ty Ty1 ≡ ty Ty2') 195 | -> tm (subst (Tm Γ) p' t) ≡ subst (Tmᴹ (con Γ)) q (tm t)) 196 | λ q -> K (Tyᴹ (con Γ)) (ty-trunc {con Γ}) (ty Ty1) 197 | (λ q -> tm (subst (Tm Γ) refl t) ≡ subst (Tmᴹ (con Γ)) q (tm t)) 198 | (ap tm (transpRefl _ t) · sym (transpRefl _ (tm t))) q 199 | 200 | Π[]-proof : ∀{Γ Δ} (A : Ty Γ) (B : Ty (Γ , A)) (σ : Tms Δ Γ) 201 | → ty ((Π A B) [ σ ]) ≡ ty (Π (A [ σ ]) (B [ σ ↑ A ])) 202 | Π[]-proof {Γ} {Δ} A B σ = 203 | Π[]ᴹ (ty A) (ty B) (tms σ) · ap (λ x → Πᴹ _ (ty B [ _ ,sᴹ x ]ᴹ)) 204 | (sym (swap-subst {t = π₂ (id (Δ , (A [ σ ]aux)))} [][] [][]ᴹ)) 205 | 206 | El-proof : ∀{Γ Δ} (σ : Tms Γ Δ) (A : Tm Δ Uaux) 207 | -> ty (Elaux A [ σ ]) ≡ ty (Elaux (subst (Tm Γ) ([]Uaux σ) (A [ σ ]'aux))) 208 | El-proof σ A = El[]ᴹ (tm A) (tms σ) · ap Elᴹ (sym (swap-subst {t = A [ σ ]'} (U[] σ) (U[]ᴹ (tms σ)))) 209 | 210 | ,∘₂ᴹ-proof : ∀{Γ Δ ∇} {τ : Tms Γ Δ} {σ : Tms ∇ Γ} {A : Ty Δ} {t : Tm Γ (A [ τ ]aux)} 211 | -> tm (subst (Tm ∇) (cong (_[_] A) ,∘₁ · sym [][]) (π₂ ((τ , t) ∘ σ))) ≡ tm (t [ σ ]') 212 | ,∘₂ᴹ-proof {Γ} {Δ} {∇} {τ} {σ} {A} {t} = 213 | swap-subst {t = π₂ ((τ , t) ∘ σ)} (cong (_[_] A) ,∘₁ · sym [][]) 214 | (cong (_[_]ᴹ (ty A)) ,∘₁ᴹ · sym [][]ᴹ) · ,∘₂ᴹ {τ = tms τ} {tms σ} {ty A} {tm t} 215 | 216 | open import Function using (_$_) 217 | 218 | lam[]-proof : ∀{Γ Δ} (A : Ty Δ) (B : Ty (Δ , A)) (σ : Tms Γ Δ) (t : Tm (Δ , A) B) 219 | -> tm ((lam t) [ σ ]') ≡ tm (subst (Tm _) (sym (Π[] A B σ)) (lam (t [ σ ↑ A ]'aux))) 220 | lam[]-proof {Γ} {Δ} A B σ t = begin 221 | (lamᴹ (tm t) [ tms σ ]'ᴹ) 222 | ≡⟨ lam[]ᴹ {A = ty A} {B = ty B} (tm t) (tms σ) ⟩ 223 | (subst (Tmᴹ _) (sym (Π[]ᴹ (ty A) (ty B) (tms σ))) (lamᴹ ((tm t) [ tms σ ↑ᴹ ty A ]'ᴹ))) 224 | ≡⟨ ap (subst (Tmᴹ _) (sym (Π[]ᴹ (ty A) (ty B) (tms σ)))) (lamᴹsub (ty A) (ty B) (tm t) (tms σ) aux) ⟩ 225 | (subst (Tmᴹ _) (sym (Π[]ᴹ (ty A) (ty B) (tms σ))) (subst (Tmᴹ _) (ap (λ z → Πᴹ (ty (A [ σ ])) (ty B [ z ]ᴹ)) (sym aux)) (tm (lam (t [ σ ↑ A ]'))))) 226 | ≡⟨ subst· {B = Tmᴹ _} (ap (λ z → Πᴹ (ty (A [ σ ])) (ty B [ z ]ᴹ)) (sym aux)) (sym (Π[]ᴹ (ty A) (ty B) (tms σ))) (tm (lam (t [ σ ↑ A ]'))) ⟩ 227 | (subst (Tmᴹ _) (ap (λ z → Πᴹ (ty (A [ σ ])) (ty B [ z ]ᴹ)) (sym aux) · sym (Π[]ᴹ (ty A) (ty B) (tms σ))) (tm (lam (t [ σ ↑ A ]')))) 228 | ≡⟨ sym (swap-subst {t = lam (t [ σ ↑ A ]')} (sym (Π[] A B σ)) (ap (λ z → Πᴹ (ty (A [ σ ])) (ty B [ z ]ᴹ)) (sym aux) · sym (Π[]ᴹ (ty A) (ty B) (tms σ)))) ⟩ 229 | (tm (subst (Tm _) (sym (Π[] A B σ)) (lam (t [ σ ↑ A ]')))) 230 | ∎ 231 | where 232 | _↑ᴹ_ : ∀{Γ Δ} → (σ : Tmsᴹ Γ Δ) → (A : Tyᴹ Δ) → Tmsᴹ (Γ ,ᴹ (A [ σ ]ᴹ)) (Δ ,ᴹ A) 233 | σ ↑ᴹ A = (σ ∘ᴹ π₁ᴹ (idᴹ _)) ,sᴹ subst (Tmᴹ _) [][]ᴹ (π₂ᴹ (idᴹ (_ ,ᴹ (A [ σ ]ᴹ)))) 234 | aux : tms σ ↑ᴹ ty A ≡ tms (σ ↑ A) 235 | aux = ap (tms (σ ∘ π₁ (id (Γ , (A [ σ ])))) ,sᴹ_) (sym (swap-subst {t = π₂ (id (_ , (A [ σ ])))} [][] [][]ᴹ)) 236 | -------------------------------------------------------------------------------- /PShModel.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --no-termination-check #-} 2 | {-# OPTIONS --prop #-} 3 | {-# OPTIONS --cubical #-} 4 | 5 | module PShModel where 6 | 7 | open import Utils 8 | open import Function using (_$_) 9 | open import Cubical.Core.Prelude 10 | open import Model 11 | open import Data.Unit 12 | open import Data.Product 13 | open import CategoryTheory 14 | open import IrrelevantProp 15 | open import Agda.Primitive 16 | 17 | open Model.Model 18 | 19 | -- co-foo : ∀{l}{A : Set l} {B : A → Set l} → (p q : Σ A B) 20 | -- → p ≡ q 21 | -- → Σ (proj₁ p ≡ proj₁ q) (λ r → subst B r (proj₂ p) ≡ proj₂ q) 22 | -- co-foo p q r = cong fst r , fromPathP (cong snd r) 23 | 24 | module _ {l l'} (C : Category {l} {l'}) where 25 | 26 | open Functor 27 | open Σ' 28 | 29 | PShC = PSh {l'' = l ⊔ l'} C 30 | 31 | PShTy : PShCon → Set _ 32 | PShTy Γ = PSh {l'' = l ⊔ l'} (∫ C Γ) 33 | 34 | PShTms : PShCon → PShCon → Set _ 35 | PShTms Δ Γ = NatTrans _ _ Δ Γ 36 | 37 | psh-swap : {Γ : PShCon} {A : PShTy Γ} 38 | → ∀{I J} (u : Category.Morph C J I) 39 | → (γ : _) (γ' : _) (γ'' : _) 40 | → (p : ∥ (Γ ₁) u γ ≡ γ' ∥) → (q : γ' ≡ γ'') 41 | → (x : (A ₀) (I , γ)) 42 | → subst (λ x → (A ₀) (J , x)) q ((A ₁) (u , p) x) ≡ (A ₁) (u , p ● ∣ q ∣) x 43 | psh-swap u γ γ' γ'' p q x = {!!} 44 | 45 | pshModel : Model 46 | Conᴹ pshModel = PShCon 47 | Tyᴹ pshModel = PShTy 48 | Tmsᴹ pshModel = λ Δ Γ → NatTrans _ _ Δ Γ 49 | Tmᴹ pshModel = 50 | λ Γ A → Σ' ((I : Obj C) → (γ : (Γ ₀) I) → (A ₀) (I , γ)) λ M 51 | → ∀{I J} → (γ : (Γ ₀) I) → (u : Morph C J I) -- → (p : ∥ (Γ ₁) u γ ≡ (Γ ₁) u γ ∥) 52 | → ∥ (A ₁) (u , ∣ refl ∣) (M I γ) ≡ M J ((Γ ₁) u γ) ∥ 53 | where open Category.Category 54 | 55 | ◇ᴹ pshModel = HasTerminalObj.one (PShTerm C) 56 | _,ᴹ_ pshModel Γ A = 57 | record { _₀ = λ c → Σ ((Γ ₀) c) λ γ → (A ₀) (c , γ) 58 | ; _₁ = λ { u (γ , x) → ((Γ ₁) u γ) , ((A ₁) (u , ∣ refl ∣) x) } 59 | ; fid = do 60 | fΓ <- fid Γ 61 | fA <- fid A 62 | ∣ (λ I → funExt _ λ { (γ , x) → 63 | Σ-≡ (cong (_$ γ) (fΓ I) , 64 | psh-swap {Γ} {A} (Category.id C I) γ _ γ 65 | ∣ refl ∣ (cong (_$ γ) (fΓ I)) x 66 | · cong (_$ x) (fA (I , γ)) )}) ∣ 67 | ; f∘ = {!!} 68 | } 69 | 70 | _[_]ᴹ pshModel {Θ} {Γ} A σ = uhm A σ 71 | idᴹ pshModel = λ Γ → IdNatTrans _ _ {Γ} 72 | εᴹ pshModel {Γ} = HasTerminalObj.bang (PShTerm C) Γ 73 | _∘ᴹ_ pshModel σ τ = σ ∘ τ 74 | where open Category.Category (PShCat {l'' = l ⊔ l'} C) 75 | π₁ᴹ pshModel σ = (λ c x → fst (fst' σ c x)) , λ f → congTr (λ f x → fst (f x)) (snd' σ f) 76 | π₂ᴹ pshModel {Γᴹ = Γ} {Δ} {A} σ = M , λ γ u → {!!} 77 | where 78 | open Category.Category 79 | M : _ 80 | M I γ = snd (fst' σ I γ) 81 | -- where 82 | -- aux = congTr (_$ γ) (snd' σ u) 83 | _,sᴹ_ pshModel σ t = (λ I γ → fst' σ I γ , fst' t I γ) , λ f → do 84 | ke <- snd' σ f 85 | ∣ funExt _ (λ x → Σ-≡ (cong (_$ x) ke , {!!})) ∣ -- psh-swap f {!!} {!!} {!!} {!!} {!!} (fst' t _ x) · {!!})) ∣ 86 | _[_]'ᴹ pshModel {Γᴹ = Γ} {Δᴹ = Δ} {Aᴹ = A} (M , h) σ = M[σ] , {!!} 87 | where 88 | M[σ] : _ 89 | M[σ] I γ = M I (fst' σ I γ) 90 | 91 | _[_]'∘ᴹ pshModel t σ = {!!} 92 | 93 | [id]ᴹ pshModel {Γᴹ = Γ} A = 94 | Functor-≡ _ _ (uhm A idtr) A 95 | (λ _ → refl) λ { {a = (I , γ)} {(J , γ')} (u , p) → 96 | transpRefl _ (subst (λ B → (A ₀) (I , fst' idtr I γ) → B) 97 | (λ _ → (A ₀) (J , fst' idtr J γ')) 98 | (λ x → (A ₁) (u , _) x)) · 99 | transpRefl _ (λ x → 100 | (A ₁) (u , _) x) · funExt _ (λ _ → refl) 101 | } 102 | where idtr = (IdNatTrans (C ᵒᵖ) Sets {Γ}) 103 | 104 | [][]ᴹ pshModel = {!!} 105 | ∘∘ᴹ pshModel = {!!} 106 | id∘ᴹ pshModel = {!!} 107 | ∘idᴹ pshModel = {!!} 108 | εηᴹ pshModel = {!!} 109 | [][]∘ᴹ pshModel = {!!} 110 | π₁βᴹ pshModel = {!!} 111 | π₂βᴹ pshModel = {!!} 112 | πηᴹ pshModel = {!!} 113 | ,∘₁ᴹ pshModel = {!!} 114 | ,∘₂ᴹ pshModel = {!!} 115 | 116 | π₂∘ᴹ pshModel σ = {!!} 117 | π₂≡ᴹ pshModel σ i = {!!} 118 | Uᴹ pshModel = {!!} 119 | U[]ᴹ pshModel σᴹ x = {!!} 120 | _[_]'Uᴹ pshModel x σ = {!!} 121 | []U≡ᴹ pshModel t σ i = {!!} 122 | Πᴹ pshModel {Γ} A B = 123 | MkFunct (λ { (I , γ) → ∀{J} (w : Morph J I) (x : (A ₀) (J , (Γ ₁) w γ)) 124 | → (B ₀) (J , ((Γ ₁) w γ , x))}) 125 | (λ { (u , p) f {J} w x → 126 | let aux = f {J} (u ∘ w) (subst (λ x → (A ₀) (J , x)) {!!} x) 127 | in subst (λ x → (B ₀) (J , x)) (Σ-≡ ({!!} , {!!})) aux }) 128 | {!!} {!!} 129 | where open Category.Category C 130 | Π[]ᴹ pshModel A B σ = {!!} 131 | Elᴹ pshModel A = {!!} 132 | El[]ᴹ pshModel A σ x = {!!} 133 | lamᴹ pshModel x = {!!} 134 | appᴹ pshModel x = {!!} 135 | βᴹ pshModel t x = {!!} 136 | ηᴹ pshModel f x = {!!} 137 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # tt-in-cubical 2 | 3 | Experiments on formalizing type theory in type theory using Cubical Agda. 4 | In particular, I'm playing with 5 | 6 | * encodings of the syntax of type theory as a higher inductive type; 7 | * category model for directed TT, and higher-dimensional models (groupoids, simplicial sets, ...) 8 | -------------------------------------------------------------------------------- /StandardModel.agda: -------------------------------------------------------------------------------- 1 | module StandardModel where 2 | 3 | open import Function 4 | open import Cubical.Core.Prelude 5 | open import Model 6 | open import Data.Product 7 | open import GeneralizedModel 8 | 9 | 10 | open import Utils 11 | open import Relation.Nullary 12 | open import IR-Universes 13 | open import Data.Unit 14 | 15 | postulate 16 | dec𝓤₁ : (x y : 𝓤₁) -> Dec (x ≡ y) 17 | hedberg : ∀{l} {A : Set l} -> ((x y : A) -> Dec (x ≡ y)) -> isSet A 18 | 19 | open GeneralizedModel.GeneralizedModel 20 | 21 | stdM : GeneralizedModel 22 | ConUniv stdM = 𝓤₂ 23 | ConEl stdM = El₂ 24 | TyUniv stdM = 𝓤₂ 25 | TyEl stdM = El₂ 26 | TmsUniv stdM = 𝓤₁ 27 | TmsEl stdM = El₁ 28 | TmUniv stdM = 𝓤₁ 29 | TmEl stdM = El₁ 30 | Conᴹ stdM = 𝓤₁-code 31 | Tyᴹ stdM = λ Γ → 𝓤₂-Π Γ (λ _ → 𝓤₁-code) 32 | Tmsᴹ stdM = λ Γ Δ → 𝓤₁-Π Γ λ _ → Δ 33 | Tmᴹ stdM = λ Γ A → 𝓤₁-Π Γ (λ ρ → A ρ) 34 | ◇ᴹ stdM = 𝓤₁-⊤ 35 | _,ᴹ_ stdM = λ Γ A → 𝓤₁-Σ Γ A 36 | Πᴹ stdM = λ A B γ → 𝓤₁-Π (A γ) λ a → B (γ , a) 37 | Uᴹ stdM = λ _ → 𝓤-code 38 | Elᴹ stdM = λ A a → cumul (A a) 39 | _[_]ᴹ stdM A σ γ = A (σ γ) 40 | idᴹ stdM Γᴹ γ = γ 41 | εᴹ stdM _ = tt 42 | εηᴹ stdM = refl 43 | _∘ᴹ_ stdM σ τ γ = σ (τ γ) 44 | [id]ᴹ stdM Aᴹ = refl 45 | [][]ᴹ stdM = refl 46 | id∘ᴹ stdM = refl 47 | ∘idᴹ stdM = refl 48 | ∘∘ᴹ stdM = refl 49 | _,sᴹ_ stdM σ t γ = σ γ , t γ 50 | π₁ᴹ stdM σ γ = fst (σ γ) 51 | π₂ᴹ stdM σ γ = snd (σ γ) 52 | π₁βᴹ stdM = refl 53 | π₂βᴹ stdM = refl 54 | πηᴹ stdM = refl 55 | _[_]'ᴹ stdM t σ γ = t (σ γ) 56 | ,∘₁ᴹ stdM = refl 57 | ,∘₂ᴹ stdM = {!!} 58 | U[]ᴹ stdM σᴹ = refl 59 | Π[]ᴹ stdM A B σ = funExt _ (λ δ → ap (𝓤₁-Π (A (σ δ))) (funExt _ (λ a → ap B (Σ-≡ (refl , {!!}))))) 60 | El[]ᴹ stdM A σ = funExt _ λ x → ap (λ x → cumul (A (σ x))) (sym (transpRefl _ x)) 61 | lamᴹ stdM t γ a = t (γ , a) 62 | appᴹ stdM t (γ , a) = t γ a 63 | βᴹ stdM t = refl 64 | ηᴹ stdM f = refl 65 | lam[]ᴹ stdM t σ = {!!} 66 | Idᴹ stdM A ((γ , a) , a') = 𝓤₁-Id (A γ) a a' 67 | ty-trunc stdM = Π-set λ _ → hedberg dec𝓤₁ 68 | -------------------------------------------------------------------------------- /Syntax.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --cubical #-} 2 | 3 | module Syntax where 4 | 5 | open import Cubical.Core.Prelude 6 | open import Utils 7 | 8 | data Con : Set 9 | data Tms : Con → Con → Set 10 | data Ty : Con -> Set 11 | data Tm : (Γ : Con) → Ty Γ → Set 12 | 13 | _,con_ : (Γ : Con) → Ty Γ → Con 14 | _[_]aux : ∀{Θ Γ} → Ty Θ → Tms Γ Θ → Ty Γ 15 | _[_]'aux : ∀{Γ Δ} {A : Ty Δ} → Tm Δ A → (σ : Tms Γ Δ) → Tm Γ (A [ σ ]aux) 16 | _,sub_ : ∀{Γ Δ} {A : Ty Δ} → (σ : Tms Γ Δ) → Tm Γ (A [ σ ]aux) → Tms Γ (Δ ,con A) 17 | π₁aux : ∀{Γ Δ} {A : Ty Δ} → Tms Γ (Δ ,con A) → Tms Γ Δ 18 | π₂aux : ∀{Γ Δ} {A : Ty Δ} → (σ : Tms Γ (Δ ,con A)) → Tm Γ (A [ π₁aux σ ]aux) 19 | idaux : ∀{Γ} → Tms Γ Γ 20 | _∘aux_ : ∀{Θ Γ Δ} → Tms Θ Δ → Tms Γ Θ → Tms Γ Δ 21 | [][]aux : ∀{Θ Γ Δ} {σ : Tms Θ Δ} {τ : Tms Γ Θ} {A : Ty Δ} 22 | → A [ σ ]aux [ τ ]aux ≡ A [ σ ∘aux τ ]aux 23 | 24 | ,∘₁aux : ∀{Γ Δ ∇} {τ : Tms Γ Δ} {σ : Tms ∇ Γ} {A : Ty Δ} {t : Tm Γ (A [ τ ]aux)} 25 | → π₁aux ((τ ,sub t) ∘aux σ) ≡ (τ ∘aux σ) 26 | 27 | Uaux : ∀{Γ} → Ty Γ 28 | []Uaux : ∀{Δ Γ} (σ : Tms Δ Γ) -> (Uaux [ σ ]aux) ≡ Uaux 29 | Elaux : ∀{Γ} → (A : Tm Γ Uaux) → Ty Γ 30 | 31 | -- π₁βaux : ∀{Γ Δ} {σ : Tms Γ Δ} {A : Ty Δ} {t : Tm Γ (A [ σ ]aux)} 32 | -- → π₁aux (σ ,sub t) ≡ σ 33 | 34 | data Con where 35 | ◇ : Con 36 | _,_ : (Γ : Con) → Ty Γ → Con 37 | 38 | data Tms where 39 | _∘_ : ∀{Θ Γ Δ} → Tms Θ Δ → Tms Γ Θ → Tms Γ Δ 40 | id : ∀ Γ → Tms Γ Γ 41 | ε : ∀{Γ} → Tms Γ ◇ 42 | _,_ : ∀{Γ Δ} {A : Ty Δ} → (σ : Tms Γ Δ) → Tm Γ (A [ σ ]aux) → Tms Γ (Δ , A) 43 | π₁ : ∀{Γ Δ} {A : Ty Δ} → Tms Γ (Δ , A) → Tms Γ Δ 44 | 45 | ∘∘ : ∀{Θ Γ Δ ∇} {σ : Tms Δ ∇} {τ : Tms Γ Δ} {δ : Tms Θ Γ} 46 | → (σ ∘ τ) ∘ δ ≡ σ ∘ (τ ∘ δ) 47 | id∘ : ∀{Γ Δ} → {σ : Tms Γ Δ} → id _ ∘ σ ≡ σ 48 | ∘id : ∀{Γ Δ} → {σ : Tms Γ Δ} → σ ∘ id _ ≡ σ 49 | εη : ∀{Γ} {σ : Tms Γ ◇} → σ ≡ ε 50 | π₁β : ∀{Γ Δ} {σ : Tms Γ Δ} {A : Ty Δ} {t : Tm Γ (A [ σ ]aux)} 51 | → π₁ (σ , t) ≡ σ 52 | πη : ∀{Γ Δ} {A : Ty Δ} {σ : Tms Γ (Δ ,con A)} → (π₁aux σ ,sub π₂aux σ) ≡ σ 53 | ,∘₁ : ∀{Γ Δ ∇} {τ : Tms Γ Δ} {σ : Tms ∇ Γ} {A : Ty Δ} {t : Tm Γ (A [ τ ]aux)} 54 | → π₁ ((τ , t) ∘ σ) ≡ (τ ∘aux σ) 55 | 56 | wk : ∀{Γ} {A : Ty Γ} → Tms (Γ , A) Γ 57 | wk = π₁ (id _) 58 | 59 | vz : ∀{Γ} {A : Ty Γ} → Tm (Γ , A) (A [ wk ]aux) 60 | vs : ∀{Γ} {A B : Ty Γ} → Tm Γ A → Tm (Γ , B) (A [ wk ]aux) 61 | 62 | _↑_ : ∀{Γ Δ} → (σ : Tms Γ Δ) → (A : Ty Δ) → Tms (Γ , (A [ σ ]aux)) (Δ , A) 63 | 64 | data Ty where 65 | -- terms of the substitution calculus 66 | _[_] : ∀{Θ Γ} → Ty Θ → Tms Γ Θ → Ty Γ 67 | 68 | [][] : ∀{Θ Γ Δ} {σ : Tms Θ Δ} {τ : Tms Γ Θ} {A : Ty Δ} 69 | → (A [ σ ]) [ τ ] ≡ A [ σ ∘ τ ] 70 | [id] : ∀ Γ → (A : Ty Γ) → A [ id _ ] ≡ A 71 | 72 | -- type formers 73 | U : ∀{Γ} → Ty Γ 74 | U[] : ∀{Δ Γ} (σ : Tms Γ Δ) → U [ σ ] ≡ U 75 | 76 | Π : ∀{Γ} (A : Ty Γ) (B : Ty (Γ , A)) → Ty Γ 77 | Π[] : ∀{Γ Δ} (A : Ty Γ) (B : Ty (Γ , A)) → (σ : Tms Δ Γ) 78 | → (Π A B) [ σ ]aux ≡ Π (A [ σ ]aux) (B [ σ ↑ A ]aux) 79 | 80 | El : ∀{Γ} → (A : Tm Γ U) → Ty Γ 81 | El[] : ∀{Γ Δ} → (A : Tm Γ Uaux) → (σ : Tms Δ Γ) 82 | → (Elaux A) [ σ ] ≡ Elaux (subst (Tm Δ) ([]Uaux σ) (A [ σ ]'aux)) 83 | 84 | data Tm where 85 | _[_]' : ∀{Γ Δ} {A : Ty Δ} → Tm Δ A → (σ : Tms Γ Δ) → Tm Γ (A [ σ ]) 86 | 87 | π₂ : ∀{Γ Δ} {A : Ty Δ} → (σ : Tms Γ (Δ , A)) → Tm Γ (A [ π₁ σ ]aux) 88 | -- π₂∘ : ∀{Γ Δ ∇} {A : Ty ∇} → {τ : Tms Δ ∇} → (σ : Tms Γ (Δ ,con (A [ τ ]aux))) 89 | -- → Tm Γ (A [ τ ∘aux π₁aux σ ]aux) 90 | -- π₂≡ : ∀{Γ Δ ∇} {A : Ty ∇} → {τ : Tms Δ ∇} → (σ : Tms Γ (Δ ,con (A [ τ ]aux))) 91 | -- → PathP (λ i → Tm Γ ([][]aux {σ = τ} {π₁aux σ} {A} i)) (π₂aux σ) (π₂∘ σ) 92 | 93 | π₂β : ∀{Γ Δ} {σ : Tms Γ Δ} {A : Ty Δ} {t : Tm Γ (A [ σ ]aux)} 94 | → PathP (λ i → Tm Γ (A [ π₁β {σ = σ} {t = t} i ]aux)) (π₂ (σ , t)) t 95 | 96 | ,∘₂ : ∀{Γ Δ ∇} {τ : Tms Γ Δ} {σ : Tms ∇ Γ} {A : Ty Δ} {t : Tm Γ (A [ τ ]aux)} 97 | → subst (Tm ∇) 98 | (cong (λ x → A [ x ]aux) ,∘₁aux · sym [][]aux) 99 | (π₂aux ((τ ,sub t) ∘aux σ)) 100 | ≡ t [ σ ]'aux 101 | 102 | -- term constructors 103 | lam : ∀{Γ} {A : Ty Γ} {B : Ty (Γ , A)} → Tm (Γ , A) B → Tm Γ (Π A B) 104 | app : ∀{Γ} {A : Ty Γ} {B : Ty (Γ , A)} → Tm Γ (Π A B) → Tm (Γ , A) B 105 | β : ∀{Γ} {A : Ty Γ} {B : Ty (Γ , A)} (t : Tm (Γ , A) B) → app (lam t) ≡ t 106 | η : ∀{Γ} {A : Ty Γ} {B : Ty (Γ , A)} (f : Tm Γ (Π A B)) → lam (app f) ≡ f 107 | 108 | lam[] : ∀{Δ Γ} {A : Ty Γ} {B : Ty (Γ , A)} (t : Tm (Γ , A) B) (σ : Tms Δ Γ) 109 | -> (lam t) [ σ ]'aux ≡ subst (Tm Δ) (sym (Π[] A B σ)) (lam (t [ σ ↑ A ]'aux)) 110 | 111 | _[_]aux = _[_] 112 | _[_]'aux = _[_]' 113 | _,con_ = _,_ 114 | _,sub_ = _,_ 115 | π₁aux = π₁ 116 | π₂aux = π₂ 117 | idaux = id _ 118 | _∘aux_ = _∘_ 119 | [][]aux = [][] 120 | ,∘₁aux = ,∘₁ 121 | Uaux = U 122 | []Uaux = U[] 123 | Elaux = El 124 | 125 | vz = π₂ (id _) 126 | vs = λ x → x [ wk ]' 127 | _↑_ {Γ} {Δ} σ A = (σ ∘ wk) , subst (Tm (Γ , (A [ σ ]aux))) [][] (π₂ (id (Γ , A [ σ ]aux))) 128 | 129 | -------------------------------------------------------------------------------- /Utils.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --allow-unsolved-metas #-} 2 | 3 | module Utils where 4 | 5 | open import Function using (_$_ ; _∘_ ; id) 6 | open import Cubical.Core.Prelude 7 | open import Cubical.Core.Glue -- Basics.Everything 8 | open import Cubical.Basics.Everything 9 | 10 | -- module _ {l l'} {A : Set l} {B C : A -> Set l'} {x y : A} 11 | -- (p : x ≡ y) (f : (x : A) -> B x -> C x) 12 | -- (u : B y) (v : B x) where 13 | 14 | -- uhm : f _ (subst B (sym p) u) ≡ subst C {!!} (f _ v) 15 | 16 | module _ {l} {l'} {A : Set l} (aset : isSet A) where 17 | 18 | K : (M : A) (C : M ≡ M -> Set l') -> C refl -> (loop : M ≡ M) -> C loop 19 | K M C h p = subst C (aset _ _ _ _) h 20 | 21 | subst2 : {ℓ ℓ' l : Level} {A : Set ℓ} {B : Set l} (C : A -> B → Set ℓ') 22 | {a a' : A} {b b' : B} → 23 | a ≡ a' -> b ≡ b' → C a b → C a' b' 24 | subst2 C p q x = subst (λ y → C y _) p (subst (C _) q x) 25 | 26 | infixl 6 _·_ 27 | _·_ = compPath 28 | 29 | subst· : ∀{l l'} {A : Set l} {B : A -> Set l'} {x y z : A} 30 | -> (p : x ≡ y) (q : y ≡ z) (u : B x) 31 | -> subst B q (subst B p u) ≡ subst B (p · q) u 32 | subst· {B = B} {x} p = 33 | J (λ _ q' → (u : B x) -> subst B q' (subst B p u) ≡ subst B (p · q') u) 34 | λ u → transpRefl _ _ · sym {!!} 35 | 36 | ap = cong 37 | 38 | cong2 : ∀{ℓ ℓ' ℓ''} {A : Set ℓ} {B : Set ℓ'} {C : Set ℓ''} 39 | {x y : A} {z w : B} (f : A → B → C) (p : x ≡ y) (q : z ≡ w) 40 | → f x z ≡ f y w 41 | cong2 = {!!} 42 | 43 | module _ {l l'} {A : Set l} {B : Set l'} (f : A -> B) where 44 | 45 | qinv : Set _ 46 | qinv = Σ (B -> A) λ g → (f ∘ g ≡ id) × (g ∘ f ≡ id) 47 | 48 | qinvIsEquiv : qinv -> isEquiv f 49 | qinvIsEquiv q = 50 | isoToIsEquiv f (fst q) (λ y → cong (_$ y) $ fst (snd q)) 51 | (λ x → cong (_$ x) $ snd (snd q)) 52 | 53 | module _ {l l'} {A : Set l} {B : A -> Set l'} where 54 | 55 | module _ {p q : Σ A B} where 56 | 57 | Σ-≡ : Σ (fst p ≡ fst q) (λ r → subst B r (snd p) ≡ snd q) → p ≡ q 58 | Σ-≡ (h1 , h2) = 59 | compPath (J (λ q1' k' → (p1 , p2) ≡ (q1' , subst B k' p2)) 60 | (cong {_} {B p1} {_} {λ _ → Σ A B} {p2} {subst B refl p2} (p1 ,_) 61 | (sym (substRefl B p2))) h1) 62 | (cong (λ x → (q1 , x)) h2) 63 | where p1 = fst p ; p2 = snd p ; q1 = fst q 64 | 65 | coΣ-≡ : p ≡ q → Σ (fst p ≡ fst q) (λ r → subst B r (snd p) ≡ snd q) 66 | coΣ-≡ eq = J {A = Σ A B} {p} (λ q' eq' → Σ _ (λ r → subst _ r (snd p) ≡ snd q')) 67 | (refl , (transpRefl _ (snd p))) eq 68 | 69 | Σiso1 : {p1 q1 : A} (r : p1 ≡ q1) {p2 : B p1} {q2 : B q1} (k : subst B r p2 ≡ q2) 70 | -> coΣ-≡ (Σ-≡ (r , k)) ≡ (r , k) 71 | Σiso1 {p1} {q1} r = 72 | J (λ q1' r' → ({p2 : B p1} {q2 : B q1'} (k : subst B r' p2 ≡ q2) 73 | -> coΣ-≡ (Σ-≡ (r' , k)) ≡ (r' , k))) (λ k → {!!}) r 74 | 75 | module _ {p q : Σ A B} where 76 | 77 | coΣ-≡-qinv : qinv coΣ-≡ 78 | coΣ-≡-qinv = Σ-≡ , (funExt _ (λ x → Σiso1 (fst x) (snd x)) , {!!}) 79 | 80 | Σ-≡-equiv : (p ≡ q) ≃ Σ (fst p ≡ fst q) (λ r → subst B r (snd p) ≡ snd q) 81 | Σ-≡-equiv = coΣ-≡ , qinvIsEquiv coΣ-≡ coΣ-≡-qinv 82 | where p1 = fst p ; p2 = snd p ; q1 = fst q 83 | 84 | module _ {l l'} {A : Set l} {B : Set l'} where 85 | 86 | ×-≡ : {p q : A × B} -> fst p ≡ fst q -> snd p ≡ snd q -> p ≡ q 87 | ×-≡ {p} h1 h2 = Σ-≡ (h1 , transpRefl B (snd p) · h2) 88 | 89 | ×-prop : ∀{l l'} {P : Set l} {Q : Set l'} 90 | -> isProp P -> isProp Q -> isProp (P × Q) 91 | ×-prop p q x y = Σ-≡ (p _ _ , q _ _) 92 | 93 | Π-prop : ∀{l l'} {A : Set l} {B : A -> Set l'} 94 | -> ((x : A) -> isProp (B x)) -> isProp ((x : A) -> B x) 95 | Π-prop h f g = funExt _ (λ x → h x _ _) 96 | 97 | funExt' : {ℓ ℓ' : Level} {A : Set ℓ} (B : A → Set ℓ') 98 | {f g : {x : A} → B x} → 99 | ((x : A) → f {x} ≡ g {x}) → _≡_ {A = {x : A} → B x} f g 100 | funExt' B {f} {g} h i {x} = h x i 101 | 102 | Σ-prop-≡ : ∀{l l'} {A : Set l} {P : A → Set l'} {p q : Σ A P} 103 | → ((x : A) → isProp (P x)) 104 | → fst p ≡ fst q 105 | → p ≡ q 106 | Σ-prop-≡ h prf = Σ-≡ (prf , h _ _ _) 107 | 108 | -- Σ-sub-isset : ∀{l l'} {A : Set l} {P : A → Set l'} {p q : Σ A P} 109 | -- -> isSet A 110 | -- -> ((x : A) → isProp (P x)) 111 | -- -> (p ≡ q) ≃ (fst p ≡ fst q) 112 | -- Σ-sub-isset {p = p} {q} ss pp = 113 | -- isoToEquiv (cong fst) (Σ-prop-≡ pp) 114 | -- (λ r → ss (fst p) (fst q) _ r) 115 | -- (λ s → {!!}) 116 | 117 | h-level : ∀{l} → ℕ → Set l → Set l 118 | h-level zero A = isContr A 119 | h-level (suc n) A = (x y : A) → h-level n (x ≡ y) 120 | 121 | h-lev-equiv : ∀{l} {A B : Set l} -> A ≃ B 122 | -> (n : ℕ) -> h-level n A -> h-level n B 123 | h-lev-equiv eqv n h = subst (h-level n) (ua eqv) h 124 | 125 | postulate 126 | propIsSet : ∀{l} (P : Set l) -> isProp P -> isSet P 127 | 128 | Σ-level : ∀{l l'} {A : Set l} {B : A -> Set l'} 129 | -> (n : ℕ) 130 | -> h-level n A 131 | -> ((x : A) -> h-level n (B x)) 132 | -> h-level n (Σ A B) 133 | Σ-level zero h1 h2 = (fst h1 , fst (h2 _)) , λ { (x , y) → 134 | Σ-≡ (snd h1 x , (sym $ snd (h2 x) (subst _ (snd h1 x) (fst (h2 (fst h1))))) 135 | · snd (h2 x) y) } 136 | Σ-level (suc n) h1 h2 (a1 , b1) (a2 , b2) = 137 | h-lev-equiv (invEquiv Σ-≡-equiv) n (Σ-level n (h1 a1 a2) λ x → h2 _ _ _) 138 | 139 | level2-is-set : ∀{l} {A : Set l} -> h-level 2 A -> isSet A 140 | level2-is-set h = λ x y p q → fst (h x y p q) 141 | 142 | postulate set-is-level2 : ∀{l} {A : Set l} -> isSet A -> h-level 2 A 143 | -- set-is-level2 h x y p q = h x y p q , λ r → {!!} 144 | 145 | Π-level : ∀{l l'} {A : Set l} {B : A -> Set l'} 146 | -> (n : ℕ) 147 | -> ((x : A) -> h-level n (B x)) 148 | -> h-level n ((x : A) -> B x) 149 | Π-level zero h = (λ x → fst (h x)) , λ y → funExt _ (λ x → snd (h x) (y x)) 150 | Π-level (suc n) h f g = {!!} 151 | 152 | _∼_ : ∀{l l'} {A : Set l} {B : A -> Set l'} (f g : (x : A) -> B x) -> Set _ 153 | f ∼ g = ((x : _) -> f x ≡ g x) 154 | 155 | open import Function 156 | 157 | funExt≃ : ∀{l l'} {A : Set l} {B : A -> Set l'} {f g : (x : A) -> B x} 158 | -> (f ≡ g) ≃ (f ∼ g) 159 | funExt≃ = isoToEquiv (λ p → λ x → cong (_$ x) p) (funExt _) 160 | (λ h → funExt _ (λ x → {!!})) λ x → {!!} 161 | 162 | Π-set : ∀{l l'} {A : Set l} {B : A -> Set l'} 163 | -> ((x : A) -> isSet (B x)) 164 | -> isSet ((x : A) -> B x) 165 | Π-set h f g p q = {!!} 166 | 167 | module _ {l} where 168 | postulate 169 | ·refl : {A : Set l} {x y : A} → (p : x ≡ y) → p · refl ≡ p 170 | refl· : {A : Set l} {x y : A} → (p : x ≡ y) → refl · p ≡ p 171 | assoc : {A : Set l} {x y z w : A} → (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) 172 | → (p · q) · r ≡ p · (q · r) 173 | 174 | inv : {A : Set l} {x y : A} → (p : x ≡ y) → sym p · p ≡ refl 175 | inv = J (λ y r → sym r · r ≡ refl) (·refl refl) 176 | 177 | hlev-upw : ∀{l} {n : ℕ} {A : Set l} → h-level n A → h-level (suc n) A 178 | hlev-upw {n = zero} h a b = p b , hh b 179 | where 180 | p : (y : _) → a ≡ y 181 | p y = sym (snd h a) · snd h y 182 | hh : (y : _) → (q : a ≡ y) → p y ≡ q 183 | hh y = J {x = a} (λ y q → p y ≡ q) (inv (snd h a)) 184 | hlev-upw {n = suc n} h x y p q = hlev-upw {n = n} (h _ _) p q 185 | 186 | Σ-set : ∀{l l'} {A : Set l} {B : A -> Set l'} 187 | -- -> (n : ℕ) 188 | -> isSet A -> ((x : A) -> isSet (B x)) 189 | -> isSet (Σ A B) 190 | Σ-set n = {!!} 191 | 192 | Σ-subset : ∀{l l'} {A : Set l} {P : A → Set l'} 193 | -> isSet A 194 | -> ((x : A) → isProp (P x)) 195 | -> isSet (Σ A P) 196 | Σ-subset ss pp = Σ-set ss (λ x → {!!}) 197 | 198 | ≡-on-≃ : ∀{l} {A : Set l} {B : Set l} {x y : A} 199 | -> (eq : A ≃ B) -> fst eq x ≡ fst eq y -> x ≡ y 200 | ≡-on-≃ {x = x} {y} eq p = sym (secEq eq x) · cong (invEq eq) p · secEq eq y 201 | 202 | module _ {l} where 203 | record ⊤ : Set l where constructor tt 204 | 205 | ⊤-is-contr : isContr ⊤ 206 | ⊤-is-contr = tt , λ _ → refl 207 | 208 | ⊤-is-set : isSet ⊤ 209 | ⊤-is-set = λ x y p q → fst (aux x y p q) 210 | where aux = hlev-upw (hlev-upw ⊤-is-contr) 211 | 212 | postulate 213 | -- ∼≃≡ : ∀{l l'} {A : Set l} {B : A → Set l'} 214 | -- → {f g : (a : A) → B a} 215 | -- → (f ∼ g) ≡ (f ≡ g) 216 | 217 | →-set : ∀{l} → {A B : Set l} → isSet A → isSet B → isSet (A → B) 218 | -- →-set a b = λ f g p q → {!∼≃≡ !} 219 | 220 | -- data ∥_∥ {l} (A : Set l) : Set l where 221 | -- ∣_∣ : A → ∥ A ∥ 222 | -- trunc : (x y : A) → ∣ x ∣ ≡ ∣ y ∣ 223 | 224 | -- join : ∀{l} {A : Set l} → ∥ ∥ A ∥ ∥ → ∥ A ∥ 225 | -- join ∣ x ∣ = x 226 | -- join (trunc x y i) = {!!} 227 | 228 | -- _>>=_ : ∀{l l'} {A : Set l} {B : Set l'} → ∥ A ∥ → (A → ∥ B ∥) → ∥ B ∥ 229 | -- ∣ x ∣ >>= f = f x 230 | -- trunc x y i >>= f = {!trunc (f x) (f y) i!} 231 | --------------------------------------------------------------------------------