diff --git a/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient.agda b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient.agda index a6271cf6042af36ae417ae35303ec58e3d12d3f5..04db6717ac4ce223c428666e063849274e5de46c 100644 --- a/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient.agda +++ b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient.agda @@ -29,6 +29,7 @@ open Category open Functor open BinCoproduct open BinProduct +open IsMonad record Model â„“ â„“' : Type (â„“-suc (â„“-max â„“ â„“')) where field @@ -67,6 +68,9 @@ record Model â„“ â„“' : Type (â„“-suc (â„“-max â„“ â„“')) where T = monad .fst + ret : ∀ {a} → cat [ a , T ⟅ a ⟆ ] + ret = monad .snd .η .NT.NatTrans.N-ob _ + _⇀_ : (a b : cat .ob) → cat .ob a ⇀ b = a ⇒ T ⟅ b ⟆ diff --git a/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient/Semantics.agda b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient/Semantics.agda index 73c9b3fb371f9bdc3f81027aba476e7cbe2add82..9a0eb56fbd19f36e359f93eff52b01dfe776559d 100644 --- a/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient/Semantics.agda +++ b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Convenient/Semantics.agda @@ -33,6 +33,7 @@ open Functor open NatTrans open BinCoproduct open BinProduct +open TyPrec private variable @@ -43,77 +44,93 @@ private E E' F F' : EvCtx Γ R S M M' N N' : Comp Γ S -module _ (M : Model â„“ â„“') where - module M = Model M - module T = IsMonad (M.monad .snd) - ⇒F = ExponentialF M.cat M.binProd M.exponentials - ⟦_⟧ty : Ty → M.cat .ob - ⟦ nat ⟧ty = M.nat - ⟦ dyn ⟧ty = M.dyn - ⟦ S ⇀ T ⟧ty = ⟦ S ⟧ty M.⇀ ⟦ T ⟧ty +module _ (𓜠: Model â„“ â„“') where + module 𓜠= Model 𓜠+ module T = IsMonad (ð“œ.monad .snd) + ⇒F = ExponentialF ð“œ.cat ð“œ.binProd ð“œ.exponentials + ⟦_⟧ty : Ty → ð“œ.cat .ob + ⟦ nat ⟧ty = ð“œ.nat + ⟦ dyn ⟧ty = ð“œ.dyn + ⟦ S ⇀ T ⟧ty = ⟦ S ⟧ty ð“œ.⇀ ⟦ T ⟧ty - ⟦_⟧e : S ⊑ R → M.cat [ ⟦ S ⟧ty , ⟦ R ⟧ty ] - ⟦_⟧p : S ⊑ R → M.cat [ ⟦ R ⟧ty , M.T ⟅ ⟦ S ⟧ty ⟆ ] - ⟦_⟧p' : S ⊑ R → M.cat [ M.T ⟅ ⟦ R ⟧ty ⟆ , M.T ⟅ ⟦ S ⟧ty ⟆ ] + ⟦_⟧e : S ⊑ R → ð“œ.cat [ ⟦ S ⟧ty , ⟦ R ⟧ty ] + ⟦_⟧p : S ⊑ R → ð“œ.cat [ ⟦ R ⟧ty , ð“œ.T ⟅ ⟦ S ⟧ty ⟆ ] + ⟦_⟧p' : S ⊑ R → ð“œ.cat [ ð“œ.T ⟅ ⟦ R ⟧ty ⟆ , ð“œ.T ⟅ ⟦ S ⟧ty ⟆ ] - ⟦ nat ⟧e = M.cat .id - ⟦ dyn ⟧e = M.cat .id + ⟦ nat ⟧e = ð“œ.cat .id + ⟦ dyn ⟧e = ð“œ.cat .id -- The most annoying one because it's not from bifunctoriality, more like separate functoriality -- λ f . λ x . x' <- p x; -- y' <- app(f,x'); -- η (e y') - ⟦ c ⇀ d ⟧e = M.lda ((T.η .N-ob _ ∘⟨ M.cat ⟩ ⟦ d ⟧e) M.∘k - (M.app' (M.π₠∘⟨ M.cat ⟩ M.Ï€â‚) M.π₂ M.∘sk - (⟦ c ⟧p ∘⟨ M.cat ⟩ M.π₂))) - ⟦ inj-nat ⟧e = M.inj ∘⟨ M.cat ⟩ M.σ1 - ⟦ inj-arr c ⟧e = M.inj ∘⟨ M.cat ⟩ M.σ2 ∘⟨ M.cat ⟩ ⟦ c ⟧e - - ⟦ nat ⟧p = T.η .N-ob M.nat - ⟦ dyn ⟧p = T.η .N-ob M.dyn + ⟦ c ⇀ d ⟧e = ð“œ.lda ((ð“œ.ret ∘⟨ ð“œ.cat ⟩ ⟦ d ⟧e) ð“œ.∘k + (ð“œ.app' (ð“œ.π₠∘⟨ ð“œ.cat ⟩ ð“œ.Ï€â‚) ð“œ.π₂ ð“œ.∘sk + (⟦ c ⟧p ∘⟨ ð“œ.cat ⟩ ð“œ.π₂))) + ⟦ inj-nat ⟧e = ð“œ.inj ∘⟨ ð“œ.cat ⟩ ð“œ.σ1 + ⟦ inj-arr c ⟧e = ð“œ.inj ∘⟨ ð“œ.cat ⟩ ð“œ.σ2 ∘⟨ ð“œ.cat ⟩ ⟦ c ⟧e + + ⟦ nat ⟧p = ð“œ.ret + ⟦ dyn ⟧p = ð“œ.ret -- = η ∘ (⟦ c ⟧e ⇒ ⟦ d ⟧p') - ⟦ c ⇀ d ⟧p = T.η .N-ob _ ∘⟨ M.cat ⟩ ⇒F ⟪ ⟦ c ⟧e , ⟦ d ⟧p' ⟫ - ⟦ inj-nat ⟧p = (T.η .N-ob _ M.|| M.℧) M.∘k M.prj - ⟦ inj-arr c ⟧p = (M.℧ M.|| ⟦ c ⟧p) M.∘k M.prj + ⟦ c ⇀ d ⟧p = ð“œ.ret ∘⟨ ð“œ.cat ⟩ ⇒F ⟪ ⟦ c ⟧e , ⟦ d ⟧p' ⟫ + ⟦ inj-nat ⟧p = (ð“œ.ret ð“œ.|| ð“œ.℧) ð“œ.∘k ð“œ.prj + ⟦ inj-arr c ⟧p = (ð“œ.℧ ð“œ.|| ⟦ c ⟧p) ð“œ.∘k ð“œ.prj ⟦ c ⟧p' = T.bind .N-ob _ ⟦ c ⟧p - ⟦_⟧ctx : Ctx → M.cat .ob - ⟦ [] ⟧ctx = M.🙠- ⟦ A ∷ Γ ⟧ctx = ⟦ Γ ⟧ctx M.× ⟦ A ⟧ty + ⟦_⟧ctx : Ctx → ð“œ.cat .ob + ⟦ [] ⟧ctx = ð“œ.🙠+ ⟦ A ∷ Γ ⟧ctx = ⟦ Γ ⟧ctx ð“œ.× ⟦ A ⟧ty -- The term syntax -- substitutions, values, ev ctxts, terms - ⟦_⟧S : Subst Δ Γ → M.cat [ ⟦ Δ ⟧ctx , ⟦ Γ ⟧ctx ] - ⟦_⟧V : Val Γ S → M.cat [ ⟦ Γ ⟧ctx , ⟦ S ⟧ty ] - ⟦_⟧E : EvCtx Γ R S → M.cat [ ⟦ Γ ⟧ctx M.× ⟦ R ⟧ty , M.T ⟅ ⟦ S ⟧ty ⟆ ] - ⟦_⟧C : Comp Γ S → M.cat [ ⟦ Γ ⟧ctx , M.T ⟅ ⟦ S ⟧ty ⟆ ] - - ⟦ ids ⟧S = M.cat .id - ⟦ γ ∘s δ ⟧S = ⟦ γ ⟧S ∘⟨ M.cat ⟩ ⟦ δ ⟧S - ⟦ ∘IdL {γ = γ} i ⟧S = M.cat .⋆IdR ⟦ γ ⟧S i - ⟦ ∘IdR {γ = γ} i ⟧S = M.cat .⋆IdL ⟦ γ ⟧S i - ⟦ ∘Assoc {γ = γ}{δ = δ}{θ = θ} i ⟧S = M.cat .⋆Assoc ⟦ θ ⟧S ⟦ δ ⟧S ⟦ γ ⟧S i - ⟦ !s ⟧S = M.!t - ⟦ []η {γ = γ} i ⟧S = M.ðŸ™Î· ⟦ γ ⟧S i - ⟦ γ ,s V ⟧S = ⟦ γ ⟧S M.,p ⟦ V ⟧V - ⟦ wk ⟧S = M.π₠- ⟦ wkβ {δ = γ}{V = V} i ⟧S = M.×β₠{f = ⟦ γ ⟧S}{g = ⟦ V ⟧V} i - ⟦ ,sη {δ = γ} i ⟧S = M.×η {f = ⟦ γ ⟧S} i - ⟦ isSetSubst γ γ' p q i j ⟧S = M.cat .isSetHom ⟦ γ ⟧S ⟦ γ' ⟧S (cong ⟦_⟧S p) (cong ⟦_⟧S q) i j - - ⟦ V [ γ ]v ⟧V = ⟦ V ⟧V ∘⟨ M.cat ⟩ ⟦ γ ⟧S - ⟦ substId {V = V} i ⟧V = M.cat .⋆IdL ⟦ V ⟧V i - ⟦ substAssoc {V = V}{δ = δ}{γ = γ} i ⟧V = M.cat .⋆Assoc ⟦ γ ⟧S ⟦ δ ⟧S ⟦ V ⟧V i - ⟦ var ⟧V = M.π₂ - ⟦ varβ {δ = γ}{V = V} i ⟧V = M.×β₂ {f = ⟦ γ ⟧S}{g = ⟦ V ⟧V} i - ⟦ zro ⟧V = {!!} - ⟦ suc ⟧V = {!!} - ⟦ lda x ⟧V = {!!} + ⟦_⟧S : Subst Δ Γ → ð“œ.cat [ ⟦ Δ ⟧ctx , ⟦ Γ ⟧ctx ] + ⟦_⟧V : Val Γ S → ð“œ.cat [ ⟦ Γ ⟧ctx , ⟦ S ⟧ty ] + ⟦_⟧E : EvCtx Γ R S → ð“œ.cat [ ⟦ Γ ⟧ctx ð“œ.× ⟦ R ⟧ty , ð“œ.T ⟅ ⟦ S ⟧ty ⟆ ] + ⟦_⟧C : Comp Γ S → ð“œ.cat [ ⟦ Γ ⟧ctx , ð“œ.T ⟅ ⟦ S ⟧ty ⟆ ] + + ⟦ ids ⟧S = ð“œ.cat .id + ⟦ γ ∘s δ ⟧S = ⟦ γ ⟧S ∘⟨ ð“œ.cat ⟩ ⟦ δ ⟧S + ⟦ ∘IdL {γ = γ} i ⟧S = ð“œ.cat .⋆IdR ⟦ γ ⟧S i + ⟦ ∘IdR {γ = γ} i ⟧S = ð“œ.cat .⋆IdL ⟦ γ ⟧S i + ⟦ ∘Assoc {γ = γ}{δ = δ}{θ = θ} i ⟧S = ð“œ.cat .⋆Assoc ⟦ θ ⟧S ⟦ δ ⟧S ⟦ γ ⟧S i + ⟦ !s ⟧S = ð“œ.!t + ⟦ []η {γ = γ} i ⟧S = ð“œ.ðŸ™Î· ⟦ γ ⟧S i + ⟦ γ ,s V ⟧S = ⟦ γ ⟧S ð“œ.,p ⟦ V ⟧V + ⟦ wk ⟧S = ð“œ.π₠+ ⟦ wkβ {δ = γ}{V = V} i ⟧S = ð“œ.×β₠{f = ⟦ γ ⟧S}{g = ⟦ V ⟧V} i + ⟦ ,sη {δ = γ} i ⟧S = ð“œ.×η {f = ⟦ γ ⟧S} i + ⟦ isSetSubst γ γ' p q i j ⟧S = ð“œ.cat .isSetHom ⟦ γ ⟧S ⟦ γ' ⟧S (cong ⟦_⟧S p) (cong ⟦_⟧S q) i j + + ⟦ V [ γ ]v ⟧V = ⟦ V ⟧V ∘⟨ ð“œ.cat ⟩ ⟦ γ ⟧S + ⟦ substId {V = V} i ⟧V = ð“œ.cat .⋆IdL ⟦ V ⟧V i + ⟦ substAssoc {V = V}{δ = δ}{γ = γ} i ⟧V = ð“œ.cat .⋆Assoc ⟦ γ ⟧S ⟦ δ ⟧S ⟦ V ⟧V i + ⟦ var ⟧V = ð“œ.π₂ + ⟦ varβ {δ = γ}{V = V} i ⟧V = ð“œ.×β₂ {f = ⟦ γ ⟧S}{g = ⟦ V ⟧V} i + ⟦ zro ⟧V = ð“œ.nat-fp .fst ∘⟨ ð“œ.cat ⟩ ð“œ.σ1 ∘⟨ ð“œ.cat ⟩ ð“œ.!t + ⟦ suc ⟧V = ð“œ.nat-fp .fst ∘⟨ ð“œ.cat ⟩ ð“œ.σ2 ∘⟨ ð“œ.cat ⟩ ð“œ.π₂ + ⟦ lda M ⟧V = ð“œ.lda ⟦ M ⟧C ⟦ fun-η i ⟧V = {!!} - ⟦ up S⊑T ⟧V = {!!} - ⟦ isSetVal V V' p q i j ⟧V = M.cat .isSetHom ⟦ V ⟧V ⟦ V' ⟧V (cong ⟦_⟧V p) (cong ⟦_⟧V q) i j + ⟦ up S⊑T ⟧V = ⟦ S⊑T .ty-prec ⟧e ∘⟨ ð“œ.cat ⟩ ð“œ.π₂ + ⟦ isSetVal V V' p q i j ⟧V = ð“œ.cat .isSetHom ⟦ V ⟧V ⟦ V' ⟧V (cong ⟦_⟧V p) (cong ⟦_⟧V q) i j + + -- | TODO: potential for generalization + -- | This is a general construction of a category from a strong monad, the "simple Kleisli slice" + ⟦ ∙E ⟧E = ð“œ.ret ∘⟨ ð“œ.cat ⟩ ð“œ.π₂ + ⟦ E ∘E F ⟧E = {!!} + ⟦ ∘IdL i ⟧E = {!!} + ⟦ ∘IdR i ⟧E = {!!} + ⟦ ∘Assoc i ⟧E = {!!} + ⟦ E [ γ ]e ⟧E = {!!} + ⟦ substId i ⟧E = {!!} + ⟦ substAssoc i ⟧E = {!!} + ⟦ ∙substDist i ⟧E = {!!} + ⟦ ∘substDist i ⟧E = {!!} + ⟦ bind x ⟧E = {!!} + ⟦ ret-η i ⟧E = {!!} + ⟦ dn S⊑T ⟧E = ⟦ S⊑T .ty-prec ⟧p ∘⟨ ð“œ.cat ⟩ ð“œ.π₂ + ⟦ isSetEvCtx E F p q i j ⟧E = ð“œ.cat .isSetHom ⟦ E ⟧E ⟦ F ⟧E (cong ⟦_⟧E p) (cong ⟦_⟧E q) i j - ⟦_⟧E = {!!} ⟦_⟧C = {!!} diff --git a/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Strength.agda b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Strength.agda index 5f8f39dd900d2aca19504253308056dd11029a08..f63a72b2d73cca8f192fd0052283e787d99e8cee 100644 --- a/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Strength.agda +++ b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Strength.agda @@ -1,7 +1,8 @@ {-# OPTIONS --cubical #-} module Semantics.Abstract.TermModel.Strength where -{- Strength of a functor between *cartesian* categories -} +{- Strength of a monad an a *cartesian* category -} +{- TODO: generalize to monoidal -} open import Cubical.Foundations.Prelude open import Cubical.Categories.Category @@ -60,6 +61,14 @@ module _ (C : Category â„“ â„“') (term : Terminal C) (bp : BinProducts C) (T : M module StrengthNotation (str : Strength) where open Notation _ bp renaming (_×_ to _×c_) σ = str .fst + + + strength-η : StrengthUnit σ + strength-η = str .snd .snd .snd .fst + + strength-μ : StrengthMult σ + strength-μ = str .snd .snd .snd .snd + -- TODO: move this upstream in Monad.Notation _∘k_ : ∀ {a b c} → C [ b , T .fst ⟅ c ⟆ ] → C [ a , T .fst ⟅ b ⟆ ] → C [ a , T .fst ⟅ c ⟆ ] f ∘k g = (IsMonad.bind (T .snd)) .N-ob _ f ∘⟨ C ⟩ g @@ -68,3 +77,4 @@ module _ (C : Category â„“ â„“') (term : Terminal C) (bp : BinProducts C) (T : M strong-bind f m = f ∘k σ .N-ob _ ∘⟨ C ⟩ (C .id ,p m) _∘sk_ = strong-bind + -- TODO: lemma for how strength interacts with bind diff --git a/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Strength/KleisliSlice.agda b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Strength/KleisliSlice.agda new file mode 100644 index 0000000000000000000000000000000000000000..412f3bff23252cf3ad7f95bfacda5fa974bb26df --- /dev/null +++ b/formalizations/guarded-cubical/Semantics/Abstract/TermModel/Strength/KleisliSlice.agda @@ -0,0 +1,72 @@ +{-# OPTIONS --cubical --lossy-unification #-} +module Semantics.Abstract.TermModel.Strength.KleisliSlice where + +{- Given a strong monad on a cartesian category and a fixed object Γ, +we get a paramaterized version of the Kleisli category -} + +open import Cubical.Foundations.Prelude +open import Cubical.Categories.Category +open import Cubical.Categories.Functor +open import Cubical.Categories.NaturalTransformation +open import Cubical.Categories.Constructions.BinProduct +open import Cubical.Categories.Limits.Terminal +open import Cubical.Categories.Limits.BinProduct +open import Cubical.Categories.Monad.Base + +open import Cubical.Categories.Limits.BinProduct.More +open import Semantics.Abstract.TermModel.Strength + +private + variable + â„“ â„“' : Level + +open Category +open Functor +open NatTrans +open BinProduct +open IsMonad + +-- +module _ (C : Category â„“ â„“') (term : Terminal C) (bp : BinProducts C) (T : Monad C) (s : Strength C term bp T) where + module C = Category C + open Notation C bp + open StrengthNotation C term bp T s + module _ (Γ : C .ob) where + KleisliSlice : Category â„“ â„“' + KleisliSlice .ob = C .ob + KleisliSlice .Hom[_,_] a b = C [ Γ × a , T .fst ⟅ b ⟆ ] + KleisliSlice .id = T .snd .η .N-ob _ C.∘ π₂ + -- Γ , x → T y |-> + -- Γ , y → T z + -------------- + -- Γ , x → T z + KleisliSlice ._⋆_ f g = bind (T .snd) .N-ob _ g C.∘ σ .N-ob _ C.∘ (π₠,p f) + -- bind (T .snd) .N-ob _ g C.∘ σ .N-ob _ C.∘ (π₠,p T .snd .η .N-ob _ C.∘ π₂) + -- + -- μ ∘ T g ∘ σ ∘ (Ï€1 , η ∘ π₂) + -- μ ∘ T g ∘ σ ∘ (id × η) + -- μ ∘ T g ∘ η + -- μ ∘ η ∘ g + -- ≡ g + KleisliSlice .⋆IdL g = + congâ‚‚ C._∘_ refl (congâ‚‚ C._∘_ refl (congâ‚‚ _,p_ (sym (C.⋆IdR _)) refl) ∙ (λ i → strength-η (~ i) _ _)) + ∙ sym (C.⋆Assoc _ _ _) + ∙ congâ‚‚ C._∘_ refl (sym (T .snd .η .N-hom _)) + ∙ C.⋆Assoc _ _ _ + ∙ cong (C._∘ g) (λ i → T .snd .idl-μ i .N-ob _) + ∙ C.⋆IdR g + -- μ ∘ T (T η ∘ π₂) ∘ σ ∘ (π₠, f) + -- μ ∘ T^2 η ∘ T π₂ ∘ σ ∘ (π₠, f) + -- T η ∘ μ ∘ T π₂ ∘ σ ∘ (π₠, f) + -- T π₂ ∘ σ ∘ (π₠, f) + -- ≡ f + KleisliSlice .⋆IdR f = {!!} + KleisliSlice .⋆Assoc = {!!} + KleisliSlice .isSetHom = C.isSetHom + + module _ {Δ : C .ob} {Γ : C .ob} where + _^* : (γ : C [ Δ , Γ ]) → Functor (KleisliSlice Γ) (KleisliSlice Δ) + (γ ^*) .F-ob a = a + (γ ^*) .F-hom f = f C.∘ (γ ×p C.id) + (γ ^*) .F-id = sym (C.⋆Assoc _ _ _) ∙ congâ‚‚ C._⋆_ (×β₂ ∙ C .⋆IdR π₂) refl + (γ ^*) .F-seq f g = {!!}