diff --git a/formalizations/guarded-cubical/Semantics/Concrete/PosetSemantics/Terms.agda b/formalizations/guarded-cubical/Semantics/Concrete/PosetSemantics/Terms.agda new file mode 100644 index 0000000000000000000000000000000000000000..345d550b774f572c14ea7d8d9d62ba0254f406e0 --- /dev/null +++ b/formalizations/guarded-cubical/Semantics/Concrete/PosetSemantics/Terms.agda @@ -0,0 +1,579 @@ +{-# OPTIONS --cubical --rewriting --guarded #-} + +{-# OPTIONS --lossy-unification #-} + +{-# OPTIONS --profile=constraints #-} + + +open import Common.Later + + +module Semantics.Concrete.PosetSemantics.Terms (k : Clock) where + + +open import Cubical.Foundations.Prelude +open import Cubical.Foundations.Isomorphism +open import Cubical.Data.List hiding ([_]) +open import Cubical.Data.Nat renaming ( â„• to Nat ) +import Cubical.HITs.PropositionalTruncation as PT +open import Cubical.Foundations.Univalence + + +open import Cubical.Data.Sigma + + +open import Cubical.Data.Empty as ⊥ + +open import Common.Common + +open import Syntax.Types +-- open import Syntax.Terms +-- open import Semantics.Abstract.TermModel.Convenient +-- open import Semantics.Abstract.TermModel.Convenient.Computations + +open import Syntax.IntensionalTerms hiding (Ï€2) + + +open import Cubical.Foundations.Structure + +open import Cubical.Relation.Binary.Poset +open import Common.Poset.Convenience +open import Common.Poset.Monotone +open import Common.Poset.Constructions +open import Common.Poset.MonotoneRelation +open import Semantics.MonotoneCombinators + hiding (S) renaming (Comp to Compose) +open import Semantics.Lift k renaming (θ to θL ; ret to Return) +open import Semantics.Concrete.DynNew k +open import Semantics.LockStepErrorOrdering k +-- open import Semantics.RepresentationSemantics k + +-- open import Semantics.Concrete.RepresentableRelation k + +open LiftPoset +open ClockedCombinators k renaming (Δ to Del) + +private + variable + â„“ â„“' : Level + + +open TyPrec + +private + variable + R R' S S' T T' : Ty + Γ Γ' Δ Δ' : Ctx + γ γ' : Subst Δ Γ + -- γ' : Subst Δ' Γ' + V V' : Val Γ S + E F : EvCtx Γ S T + E' F' : EvCtx Γ' S' T' + + M N : Comp Γ S + M' N' : Comp Γ' S' + + C : Δ ⊑ctx Δ' + D : Γ ⊑ctx Γ' + + c : S ⊑ S' + d : T ⊑ T' + +module _ {â„“o : Level} where + + -- ⇒F = ExponentialF ð“œ.cat ð“œ.binProd ð“œ.exponentials + {- + 2Cell : + {â„“A â„“'A â„“B â„“'B â„“C â„“'C â„“D â„“'D â„“R â„“S : Level} -> + {A : Poset â„“A â„“'A} {B : Poset â„“B â„“'B} {C : Poset â„“C â„“'C} {D : Poset â„“D â„“'D} -> + (R : MonRel A B â„“R) -> + (S : MonRel C D â„“S) + (f : MonFun A C) -> + (g : MonFun B D) -> + Type {!!} + 2Cell R S f g = {!!} + -} + + -- Type interpretation + {-# NON_COVERING #-} + ⟦_⟧ty : Ty → Poset â„“-zero â„“-zero + ⟦ nat ⟧ty = â„• + ⟦ dyn ⟧ty = DynP + ⟦ S ⇀ T ⟧ty = ⟦ S ⟧ty ==> 𕃠(⟦ T ⟧ty) + + -- Typing context interpretation + {-# NON_COVERING #-} + ⟦_⟧ctx : Ctx -> Poset â„“-zero â„“-zero -- Ctx → ð“œ.cat .ob + ⟦ [] ⟧ctx = UnitP -- ð“œ.🙠+ ⟦ A ∷ Γ ⟧ctx = ⟦ Γ ⟧ctx ×p ⟦ A ⟧ty -- ⟦ Γ ⟧ctx ð“œ.× ⟦ A ⟧ty + + -- Interpetations for substitutions, values, ev ctxs, and computations + -- (signatures only; definitions are below) + {-# NON_COVERING #-} + ⟦_⟧S : Subst Δ Γ → MonFun ⟦ Δ ⟧ctx ⟦ Γ ⟧ctx -- ð“œ.cat [ ⟦ Δ ⟧ctx , ⟦ Γ ⟧ctx ] + + {-# NON_COVERING #-} + ⟦_⟧V : Val Γ S → MonFun ⟦ Γ ⟧ctx ⟦ S ⟧ty -- ð“œ.cat [ ⟦ Γ ⟧ctx , ⟦ S ⟧ty ] + + {-# NON_COVERING #-} + ⟦_⟧E : EvCtx Γ R S → MonFun (⟦ Γ ⟧ctx ×p ⟦ R ⟧ty) (𕃠⟦ S ⟧ty) -- ??? + -- ð“œ.Linear ⟦ Γ ⟧ctx [ ⟦ R ⟧ty , ⟦ S ⟧ty ] + + {-# NON_COVERING #-} + ⟦_⟧C : Comp Γ S → MonFun ⟦ Γ ⟧ctx (𕃠⟦ S ⟧ty) -- ð“œ.ClLinear [ ⟦ Γ ⟧ctx , ⟦ S ⟧ty ] + + + + -- Interpretations for precision relations on types and typing contexts + -- These will be interpreted as (quasi-)representable monotone relations + {-# NON_COVERING #-} + ⟦_⟧⊑ty : S ⊑ R → MonRel ⟦ S ⟧ty ⟦ R ⟧ty â„“-zero + ⟦ nat ⟧⊑ty = poset-monrel â„• + ⟦ dyn ⟧⊑ty = poset-monrel DynP + ⟦ c ⇀ d ⟧⊑ty = ⟦ c ⟧⊑ty ==>monrel (LiftMonRel.â„ {!!} {!!} ⟦ d ⟧⊑ty) + ⟦ inj-nat ⟧⊑ty = {!!} + ⟦ inj-arr c ⟧⊑ty = {!!} + + + + -- For every type S: + -- The (monotone) relation corresponding to the reflexive precision + -- derivation S ⊑ S is the same as the relation corresponding to the + -- poset ⟦ S ⟧ + ⊑ty-refl : (S : Ty) -> ⟦ refl-⊑ S ⟧⊑ty .MonRel.R ≡ rel ⟦ S ⟧ty + ⊑ty-refl nat = funExt (λ x -> funExt (λ x' -> sym (isoToPath LiftIso))) + ⊑ty-refl dyn = funExt (λ x -> funExt (λ x' -> sym (isoToPath LiftIso))) + ⊑ty-refl (S ⇀ T) = funExt (λ f -> funExt (λ g -> + hPropExt + (isPropTwoCell (MonRel.is-prop-valued + (LiftMonRel.℠⟦ T ⟧ty ⟦ T ⟧ty (⟦ refl-⊑ T ⟧⊑ty)))) + ({!!}) + (forward f g) (backward f g))) + where + forward : (∀ f g -> ⟦ refl-⊑ (S ⇀ T) ⟧⊑ty .MonRel.R f g -> + rel ⟦ S ⇀ T ⟧ty f g) + forward f g H = TwoCell→≤mon f g + (transport + (λ i -> TwoCell + (⊑ty-refl S i) + (LiftRelation._≾_ ⟨ ⟦ T ⟧ty ⟩ ⟨ ⟦ T ⟧ty ⟩ (⊑ty-refl T i)) + (MonFun.f f) (MonFun.f g)) + H) + + backward : (∀ f g -> rel ⟦ S ⇀ T ⟧ty f g -> + ⟦ refl-⊑ (S ⇀ T) ⟧⊑ty .MonRel.R f g) + backward f g H = + transport + (λ i -> TwoCell + (sym (⊑ty-refl S) i) + (LiftRelation._≾_ ⟨ ⟦ T ⟧ty ⟩ ⟨ ⟦ T ⟧ty ⟩ (sym (⊑ty-refl T) i)) + (MonFun.f f) (MonFun.f g)) + (≤mon→≤mon-het f g H) + +{- + ⊑ty-refl : (S : Ty) -> + ((∀ x y -> ⟦ refl-⊑ S ⟧⊑ty .RepresentableRel.R .MonRel.R x y -> rel ⟦ S ⟧ty x y) × + (∀ x y -> rel ⟦ S ⟧ty x y -> ⟦ refl-⊑ S ⟧⊑ty .RepresentableRel.R .MonRel.R x y)) + + ⊑ty-refl nat .fst x y x≤y = lower x≤y + ⊑ty-refl nat .snd x y x≤y = lift x≤y + + ⊑ty-refl dyn .fst x y x≤y = lower x≤y + ⊑ty-refl dyn .snd x y x≤y = lift x≤y + + ⊑ty-refl (S ⇀ T) .fst x y x≤y = TwoCell→≤mon x y (TwoCell→TwoCell (⊑ty-refl S .snd) {!!} x≤y) + ⊑ty-refl (S ⇀ T) .snd x y x≤y = λ s s' s≤s' → {!!} +-} + + + + ⟦_⟧⊑ctx : Γ ⊑ctx Γ' → MonRel ⟦ Γ ⟧ctx ⟦ Γ' ⟧ctx â„“-zero + ⟦ [] ⟧⊑ctx = poset-monrel UnitP + ⟦ c ∷ C ⟧⊑ctx = ⟦ C ⟧⊑ctx ×monrel ⟦ c ⟧⊑ty + -- ⟦ [] ⟧⊑ctx = ð“œ.idH + -- ⟦ c ∷ C ⟧⊑ctx = ⟦ C ⟧⊑ctx ð“œ.×h ⟦ c ⟧⊑ty + + + + -- Substitutions + ⟦ ids ⟧S = MonId -- ð“œ.cat .id + ⟦ γ ∘s δ ⟧S = mCompU ⟦ γ ⟧S ⟦ δ ⟧S -- ⟦ γ ⟧S ∘⟨ ð“œ.cat ⟩ ⟦ δ ⟧S + ⟦ ∘IdL {γ = γ} i ⟧S = eqMon (mCompU MonId ⟦ γ ⟧S) ⟦ γ ⟧S refl i -- eqMon (mCompU MonId ⟦ γ ⟧S) ⟦ γ ⟧S refl i -- ð“œ.cat .⋆IdR ⟦ γ ⟧S i + ⟦ ∘IdR {γ = γ} i ⟧S = eqMon (mCompU ⟦ γ ⟧S MonId) ⟦ γ ⟧S refl i -- eqMon (mCompU ⟦ γ ⟧S MonId) ⟦ γ ⟧S refl i -- ð“œ.cat .⋆IdL ⟦ γ ⟧S i + ⟦ ∘Assoc {γ = γ}{δ = δ}{θ = θ} i ⟧S = + eqMon (mCompU ⟦ γ ⟧S (mCompU ⟦ δ ⟧S ⟦ θ ⟧S)) (mCompU (mCompU ⟦ γ ⟧S ⟦ δ ⟧S) ⟦ θ ⟧S) refl i + -- ð“œ.cat .⋆Assoc ⟦ θ ⟧S ⟦ δ ⟧S ⟦ γ ⟧S i + ⟦ !s ⟧S = UnitP! -- ð“œ.!t + ⟦ []η {γ = γ} i ⟧S = eqMon ⟦ γ ⟧S UnitP! refl i -- ð“œ.ðŸ™Î· ⟦ γ ⟧S i + ⟦ γ ,s V ⟧S = PairFun ⟦ γ ⟧S ⟦ V ⟧V -- ⟦ γ ⟧S ð“œ.,p ⟦ V ⟧V + ⟦ wk ⟧S = Ï€1 -- ð“œ.π₠+ ⟦ wkβ {δ = γ}{V = V} i ⟧S = + eqMon (mCompU Ï€1 (PairFun ⟦ γ ⟧S ⟦ V ⟧V)) ⟦ γ ⟧S refl i -- -- ð“œ.×β₠{f = ⟦ γ ⟧S}{g = ⟦ V ⟧V} i + ⟦ ,sη {δ = γ} i ⟧S = + eqMon ⟦ γ ⟧S (PairFun (mCompU Ï€1 ⟦ γ ⟧S) (mCompU Ï€2 ⟦ γ ⟧S)) refl i -- -- ð“œ.×η {f = ⟦ γ ⟧S} i + ⟦ isSetSubst γ γ' p q i j ⟧S = + MonFunIsSet ⟦ γ ⟧S ⟦ γ' ⟧S (cong ⟦_⟧S p) (cong ⟦_⟧S q) i j -- follows because MonFun is a set + -- ⟦ isPosetSubst {γ = γ} {γ' = γ'} γ⊑γ' γ'⊑γ i ⟧S = {!!} + + + + -- Values + ⟦ V [ γ ]v ⟧V = mCompU ⟦ V ⟧V ⟦ γ ⟧S + ⟦ substId {V = V} i ⟧V = + eqMon (mCompU ⟦ V ⟧V MonId) ⟦ V ⟧V refl i + ⟦ substAssoc {V = V}{δ = δ}{γ = γ} i ⟧V = + eqMon (mCompU ⟦ V ⟧V (mCompU ⟦ δ ⟧S ⟦ γ ⟧S)) + (mCompU (mCompU ⟦ V ⟧V ⟦ δ ⟧S) ⟦ γ ⟧S) + refl i + ⟦ var ⟧V = Ï€2 + ⟦ varβ {δ = γ}{V = V} i ⟧V = + eqMon (mCompU Ï€2 ⟦ γ ,s V ⟧S) ⟦ V ⟧V refl i + ⟦ zro ⟧V = Zero + ⟦ suc ⟧V = Suc + ⟦ lda M ⟧V = Curry ⟦ M ⟧C + ⟦ fun-η {V = V} i ⟧V = eqMon + ⟦ V ⟧V + (Curry (mCompU (mCompU (mCompU App Ï€2) PairAssocLR) + (PairFun (PairFun UnitP! (mCompU ⟦ V ⟧V Ï€1)) Ï€2))) + (funExt (λ ⟦Γ⟧ -> eqMon _ _ refl)) i + -- eqMon ⟦ V ⟧V (Curry + -- (mCompU (mCompU (mCompU App Ï€2) PairAssocLR) + -- (PairFun (PairFun UnitP! (mCompU ⟦ V ⟧V Ï€1)) Ï€2))) (funExt λ x → eqMon _ _ refl) i + -- eqMon ⟦ V ⟧V (Curry ⟦ appP [ !s ,s (V [ wk ]v) ,s var ]cP ⟧C) {!!} i + -- V ≡ lda (appP [ (!s ,s (V [ wk ]v)) ,s var ]cP) + -- ⟦ up S⊑T ⟧V = {!!} + -- ⟦ δl S⊑T ⟧V = Ï€2 + -- ⟦ δr S⊑T ⟧V = Ï€2 + ⟦ isSetVal V V' p q i j ⟧V = + MonFunIsSet ⟦ V ⟧V ⟦ V' ⟧V (cong ⟦_⟧V p) (cong ⟦_⟧V q) i j + -- ⟦ isPosetVal {V = V} {V' = V'} V⊑V' V'⊑V i ⟧V = + -- ≤mon-antisym ⟦ V ⟧V ⟦ V' ⟧V + -- {!!} + -- (TwoCell→≤mon ⟦ V' ⟧V ⟦ V ⟧V (TwoCell→TwoCell {!!} {!!} ⟦ V'⊑V ⟧V⊑)) i + + + -- Evaluation Contexts + ⟦ ∙E {Γ = Γ} ⟧E = mCompU mRet Ï€2 -- mCompU mRet Ï€2 + ⟦ E ∘E F ⟧E = mExt' _ ⟦ E ⟧E ∘m ⟦ F ⟧E + ⟦ ∘IdL {E = E} i ⟧E = + eqMon (mExt' _ (mCompU mRet Ï€2) ∘m ⟦ E ⟧E) ⟦ E ⟧E (funExt (λ x → monad-unit-r (MonFun.f ⟦ E ⟧E x))) i + ⟦ ∘IdR {E = E} i ⟧E = + eqMon (mExt' _ ⟦ E ⟧E ∘m mCompU mRet Ï€2) ⟦ E ⟧E (funExt (λ x → monad-unit-l _ _)) i + ⟦ ∘Assoc {E = E}{F = F}{F' = F'} i ⟧E = + eqMon (mExt' _ ⟦ E ⟧E ∘m (mExt' _ ⟦ F ⟧E ∘m ⟦ F' ⟧E)) + (mExt' _ (mExt' _ ⟦ E ⟧E ∘m ⟦ F ⟧E) ∘m ⟦ F' ⟧E) + (funExt (λ x → monad-assoc _ _ _)) i + ⟦ E [ γ ]e ⟧E = mCompU ⟦ E ⟧E (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2) + ⟦ substId {E = E} i ⟧E = eqMon (mCompU ⟦ E ⟧E (PairFun (mCompU MonId Ï€1) Ï€2)) ⟦ E ⟧E refl i + ⟦ substAssoc {E = E}{γ = γ}{δ = δ} i ⟧E = + eqMon (mCompU ⟦ E ⟧E (PairFun (mCompU (mCompU ⟦ γ ⟧S ⟦ δ ⟧S) Ï€1) Ï€2)) + (mCompU (mCompU ⟦ E ⟧E (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2)) (PairFun (mCompU ⟦ δ ⟧S Ï€1) Ï€2)) + refl i + -- For some reason, using refl, or even funExt with refl, in the third argument + -- to eqMon below leads to an error when lossy unification is turned on. + -- This seems to be fixed by using congS η refl + ⟦ ∙substDist {γ = γ} i ⟧E = eqMon + (mCompU (mCompU mRet Ï€2) + (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2)) (mCompU mRet Ï€2) + (funExt (λ {(⟦Γ⟧ , ⟦R⟧) -> congS η refl})) i + ⟦ ∘substDist {E = E}{F = F}{γ = γ} i ⟧E = + eqMon (mCompU (mExt' _ ⟦ E ⟧E ∘m ⟦ F ⟧E) (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2)) + (mExt' _ (mCompU ⟦ E ⟧E (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2)) ∘m mCompU ⟦ F ⟧E (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2)) + refl i + -- (E ∘E F) [ γ ]e ≡ (E [ γ ]e) ∘E (F [ γ ]e) + ⟦ bind M ⟧E = ⟦ M ⟧C + + -- E ≡ bind (E [ wk ]e [ retP [ !s ,s var ]cP ]∙P) + ⟦ ret-η {Γ}{R}{S}{E} i ⟧E = + eqMon ⟦ E ⟧E (Bind (⟦ Γ ⟧ctx ×p ⟦ R ⟧ty) + (mCompU (mCompU mRet Ï€2) (PairFun UnitP! Ï€2)) + (mCompU ⟦ E ⟧E (PairFun (mCompU Ï€1 Ï€1) Ï€2))) + (funExt (λ x → sym (ext-eta _ _))) i + {-- explicit i where + explicit : ⟦ E ⟧E + ≡ ð“œ.bindP (ð“œ.pull ð“œ.π₠⟪ ⟦ E ⟧E ⟫) ∘⟨ ð“œ.cat ⟩ (ð“œ.cat .id ð“œ.,p (ð“œ.retP ∘⟨ ð“œ.cat ⟩ (ð“œ.!t ð“œ.,p ð“œ.π₂))) + explicit = sym (congâ‚‚ (comp' ð“œ.cat) (sym ð“œ.bind-natural) refl + ∙ sym (ð“œ.cat .⋆Assoc _ _ _) + ∙ congâ‚‚ (comp' ð“œ.cat) refl (ð“œ.,p-natural ∙ congâ‚‚ ð“œ._,p_ (sym (ð“œ.cat .⋆Assoc _ _ _) ∙ congâ‚‚ (comp' ð“œ.cat) refl ð“œ.×β₠∙ ð“œ.cat .⋆IdL _) + (ð“œ.×β₂ ∙ congâ‚‚ (comp' ð“œ.cat) refl (congâ‚‚ ð“œ._,p_ ð“œ.ðŸ™Î·' refl) ∙ ð“œ.η-natural {γ = ð“œ.!t})) + ∙ ð“œ.bindP-l) --} + --⟦ dn S⊑T ⟧E = {!!} -- ⟦ S⊑T .ty-prec ⟧p ∘⟨ ð“œ.cat ⟩ ð“œ.π₂ + ⟦ isSetEvCtx E F p q i j ⟧E = MonFunIsSet ⟦ E ⟧E ⟦ F ⟧E (cong ⟦_⟧E p) (cong ⟦_⟧E q) i j -- ð“œ.cat .isSetHom ⟦ E ⟧E ⟦ F ⟧E (cong ⟦_⟧E p) (cong ⟦_⟧E q) i j + --⟦ δl S⊑T ⟧E = mCompU mRet Ï€2 + --⟦ δr S⊑T ⟧E = mCompU mRet Ï€2 + --⟦ isPosetEvCtx x xâ‚ i ⟧E = {!eqMon ?!} + + + matchNat-helper : {â„“X â„“'X â„“Y â„“'Y : Level} {X : Poset â„“X â„“'X} {Y : Poset â„“Y â„“'Y} -> + MonFun X Y -> MonFun (X ×p â„•) Y -> MonFun (X ×p â„•) Y + matchNat-helper fZ fS = + record { f = λ { (Γ , zero) → MonFun.f fZ Γ ; + (Γ , suc n) → MonFun.f fS (Γ , n) } ; + isMon = λ { {Γ1 , zero} {Γ2 , zero} (Γ1≤Γ2 , n1≤n2) → MonFun.isMon fZ Γ1≤Γ2 ; + {Γ1 , zero} {Γ2 , suc n2} (Γ1≤Γ2 , n1≤n2) → rec (znots n1≤n2) ; + {Γ1 , suc n1} {Γ2 , zero} (Γ1≤Γ2 , n1≤n2) → rec (snotz n1≤n2) ; + {Γ1 , suc n1} {Γ2 , suc n2} (Γ1≤Γ2 , n1≤n2) → MonFun.isMon fS (Γ1≤Γ2 , injSuc n1≤n2)} } + + + -- Computations + ⟦ _[_]∙ {Γ = Γ} E M ⟧C = Bind ⟦ Γ ⟧ctx ⟦ M ⟧C ⟦ E ⟧E + ⟦ plugId {M = M} i ⟧C = + eqMon (Bind _ ⟦ M ⟧C (mCompU mRet Ï€2)) ⟦ M ⟧C (funExt (λ x → monad-unit-r (U ⟦ M ⟧C x))) i + ⟦ plugAssoc {F = F}{E = E}{M = M} i ⟧C = + eqMon (Bind _ ⟦ M ⟧C (mExt' _ ⟦ F ⟧E ∘m ⟦ E ⟧E)) + (Bind _ (Bind _ ⟦ M ⟧C ⟦ E ⟧E) ⟦ F ⟧E) + (funExt (λ ⟦Γ⟧ → sym (monad-assoc + (λ z → MonFun.f ⟦ E ⟧E (⟦Γ⟧ , z)) + (MonFun.f (Ï€2 .MonFun.f (⟦Γ⟧ , U (Curry ⟦ F ⟧E) ⟦Γ⟧))) + (MonFun.f ⟦ M ⟧C ⟦Γ⟧)))) + i + ⟦ M [ γ ]c ⟧C = mCompU ⟦ M ⟧C ⟦ γ ⟧S -- ⟦ M ⟧C ∘⟨ ð“œ.cat ⟩ ⟦ γ ⟧S + ⟦ substId {M = M} i ⟧C = + eqMon (mCompU ⟦ M ⟧C MonId) ⟦ M ⟧C refl i -- ð“œ.cat .⋆IdL ⟦ M ⟧C i + ⟦ substAssoc {M = M}{δ = δ}{γ = γ} i ⟧C = + eqMon (mCompU ⟦ M ⟧C (mCompU ⟦ δ ⟧S ⟦ γ ⟧S)) + (mCompU (mCompU ⟦ M ⟧C ⟦ δ ⟧S) ⟦ γ ⟧S) + refl i -- ð“œ.cat .⋆Assoc ⟦ γ ⟧S ⟦ δ ⟧S ⟦ M ⟧C i + ⟦ substPlugDist {E = E}{M = M}{γ = γ} i ⟧C = + eqMon (mCompU (Bind _ ⟦ M ⟧C ⟦ E ⟧E) ⟦ γ ⟧S) (Bind _ (mCompU ⟦ M ⟧C ⟦ γ ⟧S) + (mCompU ⟦ E ⟧E (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2))) + refl i + ⟦ err {S = S} ⟧C = K _ ℧ -- mCompU mRet {!!} -- ð“œ.err + ⟦ strictness {E = E} i ⟧C = + eqMon (Bind _ (mCompU (K UnitP ℧) UnitP!) ⟦ E ⟧E) + (mCompU (K UnitP ℧) UnitP!) + (funExt (λ _ -> ext-err _)) i -- ð“œ.℧-homo ⟦ E ⟧E i + -- i = i0 ⊢ Bind ⟦ Γ ⟧ctx (mCompU (K UnitP ℧) UnitP!) ⟦ E ⟧E + -- i = i1 ⊢ mCompU (K UnitP ℧) UnitP! + ⟦ ret ⟧C = mCompU mRet Ï€2 + ⟦ ret-β {S}{T}{Γ}{M = M} i ⟧C = eqMon (Bind (⟦ Γ ⟧ctx ×p ⟦ T ⟧ty) + (mCompU (mCompU mRet Ï€2) (PairFun UnitP! Ï€2)) + (mCompU ⟦ M ⟧C (PairFun (mCompU Ï€1 Ï€1) Ï€2))) ⟦ M ⟧C (funExt (λ x → monad-unit-l _ _)) i + ⟦ app ⟧C = mCompU (mCompU App Ï€2) PairAssocLR + ⟦ fun-β {M = M} i ⟧C = + eqMon (mCompU (mCompU (mCompU App Ï€2) PairAssocLR) + (PairFun (PairFun UnitP! (mCompU (Curry ⟦ M ⟧C) Ï€1)) Ï€2)) + ⟦ M ⟧C refl i + ⟦ matchNat Mz Ms ⟧C = matchNat-helper ⟦ Mz ⟧C ⟦ Ms ⟧C + -- record { f = λ { (Γ , zero) → MonFun.f ⟦ Mz ⟧C Γ ; + -- (Γ , suc n) → MonFun.f ⟦ Ms ⟧C (Γ , n) } ; + -- isMon = λ { {Γ1 , zero} {Γ2 , zero} (Γ1≤Γ2 , n1≤n2) → MonFun.isMon ⟦ Mz ⟧C Γ1≤Γ2 ; + -- {Γ1 , zero} {Γ2 , suc n2} (Γ1≤Γ2 , n1≤n2) → rec (znots n1≤n2) ; + -- {Γ1 , suc n1} {Γ2 , zero} (Γ1≤Γ2 , n1≤n2) → rec (snotz n1≤n2) ; + -- {Γ1 , suc n1} {Γ2 , suc n2} (Γ1≤Γ2 , n1≤n2) → MonFun.isMon ⟦ Ms ⟧C (Γ1≤Γ2 , injSuc n1≤n2)} } + ⟦ matchNatβz Mz Ms i ⟧C = eqMon + (mCompU (matchNat-helper ⟦ Mz ⟧C ⟦ Ms ⟧C) + (PairFun MonId (mCompU Zero UnitP!))) + ⟦ Mz ⟧C + refl i + ⟦ matchNatβs Mz Ms V i ⟧C = eqMon + (mCompU (matchNat-helper ⟦ Mz ⟧C ⟦ Ms ⟧C) + (PairFun MonId (mCompU Suc (PairFun UnitP! ⟦ V ⟧V)))) + (mCompU ⟦ Ms ⟧C (PairFun MonId ⟦ V ⟧V)) + refl i + ⟦ matchNatη {M = M} i ⟧C = eqMon + ⟦ M ⟧C + (matchNat-helper + (mCompU ⟦ M ⟧C (PairFun MonId (mCompU Zero UnitP!))) + (mCompU ⟦ M ⟧C (PairFun Ï€1 (mCompU Suc (PairFun UnitP! Ï€2))))) + (funExt (λ { (⟦Γ⟧ , zero) → refl ; + (⟦Γ⟧ , suc n) → refl})) + i + ⟦ isSetComp M N p q i j ⟧C = MonFunIsSet ⟦ M ⟧C ⟦ N ⟧C (cong ⟦_⟧C p) (cong ⟦_⟧C q) i j -- ð“œ.cat .isSetHom ⟦ M ⟧C ⟦ N ⟧C (cong ⟦_⟧C p) (cong ⟦_⟧C q) i j + --⟦ isPosetComp p q i ⟧C = {!!} + + + + ----------------------------------------- + -- Logic semantics + ----------------------------------------- + +{- + -- Substitutions + ⟦ !s ⟧S⊑ = λ a b x → lift refl + ⟦ γ⊑γ' ,s V⊑V' ⟧S⊑ = λ x y x≤y → (⟦ γ⊑γ' ⟧S⊑ x y x≤y) , (⟦ V⊑V' ⟧V⊑ x y x≤y) + ⟦ γ⊑γ' ∘s δ⊑δ' ⟧S⊑ = λ x y x≤y → ⟦ γ⊑γ' ⟧S⊑ _ _ (⟦ δ⊑δ' ⟧S⊑ x y x≤y) + ⟦ _ids_ ⟧S⊑ = λ x y x≤y → x≤y + ⟦ isProp⊑ p q i ⟧S⊑ = + isPropTwoCell (MonRel.is-prop-valued (⟦ _ ⟧⊑ctx .RepresentableRel.R)) ⟦ p ⟧S⊑ ⟦ q ⟧S⊑ i + ⟦ hetTrans γ⊑γ'' γ''⊑γ' ⟧S⊑ = λ x y x≤y → {!!} + + -- Values + ⟦ V⊑V' [ γ⊑γ' ]v ⟧V⊑ ⟦Γ⟧ ⟦Γ'⟧ ⟦Γ⟧≤⟦Γ'⟧ = ⟦ V⊑V' ⟧V⊑ _ _ (⟦ γ⊑γ' ⟧S⊑ ⟦Γ⟧ ⟦Γ'⟧ ⟦Γ⟧≤⟦Γ'⟧) + ⟦ var ⟧V⊑ (⟦Γ⟧ , x) (⟦Γ'⟧ , y) (⟦Γ⟧≤⟦Γ'⟧ , x≤y) = x≤y + ⟦ zro ⟧V⊑ _ _ _ = lift refl + ⟦ suc ⟧V⊑ (tt , n) (tt , m) (_ , n≡m) = lift (cong suc (lower n≡m)) + ⟦ lda M⊑M' ⟧V⊑ ⟦Γ⟧ ⟦Γ'⟧ ⟦Γ⟧≤⟦Γ'⟧ x y x≤y = ⟦ M⊑M' ⟧C⊑ (⟦Γ⟧ , x) (⟦Γ'⟧ , y) (⟦Γ⟧≤⟦Γ'⟧ , x≤y) + ⟦ up-L S⊑T ⟧V⊑ = {!!} + ⟦ up-R S⊑T ⟧V⊑ = {!!} + ⟦ isProp⊑ p q i ⟧V⊑ = {!!} + ⟦ hetTrans V⊑V' V'⊑V'' ⟧V⊑ = {!!} + + + -- Evaluation Contexts + + -- Computations + ⟦ x ⟧C⊑ = {!!} + -} + + + + + -- Bisim : (S : Ty) -> MonRel ⟦ S ⟧ty ⟦ S ⟧ty + -- Bisim nat = IdMonRel â„• + -- Bisim S ⇀ T = Bisim S ==>R (𕃠(Bisim T)) + -- Bisim dyn = DynR + + -- ⟦ c ⟧⊑ty + + + + + +{- + ⟦_⟧e : S ⊑ R → MonFun ⟦ S ⟧ty ⟦ R ⟧ty + ⟦_⟧p : S ⊑ R → MonFun ⟦ R ⟧ty (𕃠⟦ S ⟧ty) + ⟦_⟧p' : S ⊑ R → MonFun (𕃠⟦ R ⟧ty) (𕃠⟦ S ⟧ty) + + + ⟦ nat ⟧e = MonId + ⟦ dyn ⟧e = MonId + -- 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 = {!!} + ⟦ inj-nat ⟧e = InjNat -- ð“œ.inj ∘⟨ ð“œ.cat ⟩ ð“œ.σ1 + ⟦ inj-arr c ⟧e = mCompU InjArr ⟦ c ⟧e -- ð“œ.inj ∘⟨ ð“œ.cat ⟩ ð“œ.σ2 ∘⟨ ð“œ.cat ⟩ ⟦ c ⟧e + + + ⟦ nat ⟧p = mRet + ⟦ dyn ⟧p = mRet + -- = η ∘ (⟦ c ⟧e ⇒ ⟦ d ⟧p') + ⟦ c ⇀ d ⟧p = mCompU (mCompU mRet {!!}) (Bind _ {!⟦ c ⇀ d ⟧e !} {!!}) -- ð“œ.ClLinear .id ∘⟨ ð“œ.cat ⟩ ⇒F ⟪ ⟦ c ⟧e , ⟦ d ⟧p' ⟫ + ⟦ inj-nat ⟧p = {!!} -- (ð“œ.ClLinear .id ð“œ.|| ð“œ.℧) ∘⟨ ð“œ.ClLinear ⟩ ð“œ.prj + ⟦ inj-arr c ⟧p = {!!} -- (ð“œ.℧ ð“œ.|| ⟦ c ⟧p) ∘⟨ ð“œ.ClLinear ⟩ ð“œ.prj + + + ⟦ c ⟧p' = {!!} -- ð“œ.clBind ⟦ c ⟧p + + + + -- Weak bisimilarity relation + Bisim : (S : Ty) -> MonRel ⟦ S ⟧ty ⟦ S ⟧ty â„“ + Bisim nat = {!!} + Bisim dyn = {!!} + Bisim (S ⇀ T) = {!!} +-} + + + + + + + {- + + -- The term syntax + -- substitutions, values, ev ctxts, terms + + ⟦_⟧S : Subst Δ Γ → ð“œ.cat [ ⟦ Δ ⟧ctx , ⟦ Γ ⟧ctx ] + ⟦_⟧V : Val Γ S → ð“œ.cat [ ⟦ Γ ⟧ctx , ⟦ S ⟧ty ] + ⟦_⟧E : EvCtx Γ R S → ð“œ.Linear ⟦ Γ ⟧ctx [ ⟦ R ⟧ty , ⟦ S ⟧ty ] + ⟦_⟧C : Comp Γ S → ð“œ.ClLinear [ ⟦ Γ ⟧ctx , ⟦ 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 = ⟦ 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 + + ⟦ ∙E ⟧E = ð“œ.Linear _ .id + ⟦ E ∘E F ⟧E = ⟦ E ⟧E ∘⟨ ð“œ.Linear _ ⟩ ⟦ F ⟧E + ⟦ ∘IdL {E = E} i ⟧E = ð“œ.Linear _ .⋆IdR ⟦ E ⟧E i + ⟦ ∘IdR {E = E} i ⟧E = ð“œ.Linear _ .⋆IdL ⟦ E ⟧E i + ⟦ ∘Assoc {E = E}{F = F}{F' = F'} i ⟧E = ð“œ.Linear _ .⋆Assoc ⟦ F' ⟧E ⟦ F ⟧E ⟦ E ⟧E i + ⟦ E [ γ ]e ⟧E = (ð“œ.pull ⟦ γ ⟧S) ⟪ ⟦ E ⟧E ⟫ + ⟦ substId {E = E} i ⟧E = ð“œ.id^* i ⟪ ⟦ E ⟧E ⟫ + ⟦ substAssoc {E = E}{γ = γ}{δ = δ} i ⟧E = ð“œ.comp^* ⟦ γ ⟧S ⟦ δ ⟧S i ⟪ ⟦ E ⟧E ⟫ + ⟦ ∙substDist {γ = γ} i ⟧E = (ð“œ.pull ⟦ γ ⟧S) .F-id i + + ⟦ ∘substDist {E = E}{F = F}{γ = γ} i ⟧E = ð“œ.pull ⟦ γ ⟧S .F-seq ⟦ F ⟧E ⟦ E ⟧E i + ⟦ bind M ⟧E = ⟦ M ⟧C + -- E ≡ + -- bind (E [ wk ]e [ retP [ !s ,s var ]c ]∙) + ⟦ ret-η {Γ}{R}{S}{E} i ⟧E = explicit i where + explicit : ⟦ E ⟧E + ≡ ð“œ.bindP (ð“œ.pull ð“œ.π₠⟪ ⟦ E ⟧E ⟫) ∘⟨ ð“œ.cat ⟩ (ð“œ.cat .id ð“œ.,p (ð“œ.retP ∘⟨ ð“œ.cat ⟩ (ð“œ.!t ð“œ.,p ð“œ.π₂))) + explicit = sym (congâ‚‚ (comp' ð“œ.cat) (sym ð“œ.bind-natural) refl + ∙ sym (ð“œ.cat .⋆Assoc _ _ _) + ∙ congâ‚‚ (comp' ð“œ.cat) refl (ð“œ.,p-natural ∙ congâ‚‚ ð“œ._,p_ (sym (ð“œ.cat .⋆Assoc _ _ _) ∙ congâ‚‚ (comp' ð“œ.cat) refl ð“œ.×β₠∙ ð“œ.cat .⋆IdL _) + (ð“œ.×β₂ ∙ congâ‚‚ (comp' ð“œ.cat) refl (congâ‚‚ ð“œ._,p_ ð“œ.ðŸ™Î·' refl) ∙ ð“œ.η-natural {γ = ð“œ.!t})) + ∙ ð“œ.bindP-l) + ⟦ 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 [ M ]∙ ⟧C = (COMP _ 𓜠⟪ ⟦ E ⟧E ⟫) ⟦ M ⟧C + ⟦ plugId {M = M} i ⟧C = (COMP _ 𓜠.F-id i) ⟦ M ⟧C + ⟦ plugAssoc {F = F}{E = E}{M = M} i ⟧C = (COMP _ 𓜠.F-seq ⟦ E ⟧E ⟦ F ⟧E i) ⟦ M ⟧C + + ⟦ M [ γ ]c ⟧C = ⟦ M ⟧C ∘⟨ ð“œ.cat ⟩ ⟦ γ ⟧S + ⟦ substId {M = M} i ⟧C = ð“œ.cat .⋆IdL ⟦ M ⟧C i + ⟦ substAssoc {M = M}{δ = δ}{γ = γ} i ⟧C = ð“œ.cat .⋆Assoc ⟦ γ ⟧S ⟦ δ ⟧S ⟦ M ⟧C i + ⟦ substPlugDist {E = E}{M = M}{γ = γ} i ⟧C = COMP-Enriched 𓜠⟦ γ ⟧S ⟦ M ⟧C ⟦ E ⟧E i + ⟦ err ⟧C = ð“œ.err + ⟦ strictness {E = E} i ⟧C = ð“œ.℧-homo ⟦ E ⟧E i + + ⟦ ret ⟧C = ð“œ.retP + -- (bind M [ wk ]e [ ret [ !s ,s var ]c ]∙) + -- ≡ bind (π₂ ^* M) ∘ (id , ret [ !s ,s var ]c) + -- ≡ bind (π₂ ^* M) ∘ (id , id ∘ (! , π₂)) + -- ≡ π₂ ^* bind M ∘ (id , (! , π₂)) + -- ≡ M + ⟦ ret-β {S}{T}{Γ}{M = M} i ⟧C = explicit i where + explicit : + -- pull γ ⟪ f ⟫ = f ∘ ((γ ∘⟨ C ⟩ Ï€â‚) ,p π₂) + -- pull π₠⟪ f ⟫ = f ∘ ((π₠∘⟨ C ⟩ Ï€â‚) ,p π₂) + ð“œ.bindP ((ð“œ.pull ð“œ.Ï€â‚) ⟪ ⟦ M ⟧C ⟫) + ∘⟨ ð“œ.cat ⟩ (ð“œ.cat .id ð“œ.,p (ð“œ.retP ∘⟨ ð“œ.cat ⟩ (ð“œ.!t ð“œ.,p ð“œ.π₂))) + ≡ ⟦ M ⟧C + explicit = + congâ‚‚ (comp' ð“œ.cat) (sym ð“œ.bind-natural) refl + ∙ (sym (ð“œ.cat .⋆Assoc _ _ _) + -- (π₠∘ π₠,p π₂) ∘ ((ð“œ.cat .id) ,p (η ∘ !t , π₂)) + -- (π₠∘ π₠,p π₂) ∘ ((ð“œ.cat .id) ,p (η ∘ !t , π₂)) + ∙ congâ‚‚ (comp' ð“œ.cat) refl (ð“œ.,p-natural ∙ congâ‚‚ ð“œ._,p_ (sym (ð“œ.cat .⋆Assoc _ _ _) ∙ congâ‚‚ (comp' ð“œ.cat) refl ð“œ.×β₠∙ ð“œ.cat .⋆IdL _) ð“œ.×β₂)) + -- ret ∘ (!t , π₂) + -- ≡ ret ∘ (π₠∘ !t , π₂) + ∙ congâ‚‚ (comp' (ð“œ.With ⟦ Γ ⟧ctx)) refl (congâ‚‚ (comp' ð“œ.cat) refl (congâ‚‚ ð“œ._,p_ ð“œ.ðŸ™Î·' refl) ∙ ð“œ.η-natural {γ = ð“œ.!t}) + ∙ ð“œ.bindP-l + + ⟦ app ⟧C = {!!} + ⟦ fun-β i ⟧C = {!!} + + ⟦ matchNat Mz Ms ⟧C = {!!} + ⟦ matchNatβz Mz Ms i ⟧C = {!!} + ⟦ matchNatβs Mz Ms V i ⟧C = {!!} + ⟦ matchNatη i ⟧C = {!!} + + ⟦ isSetComp M N p q i j ⟧C = ð“œ.cat .isSetHom ⟦ M ⟧C ⟦ N ⟧C (cong ⟦_⟧C p) (cong ⟦_⟧C q) i j + +-}