diff --git a/formalizations/guarded-cubical/Semantics/Concrete/DoublePosetSemantics/Terms.agda b/formalizations/guarded-cubical/Semantics/Concrete/DoublePosetSemantics/Terms.agda new file mode 100644 index 0000000000000000000000000000000000000000..cabb6a191fb04c9d4bdb4cb1047467d13c2f5dbe --- /dev/null +++ b/formalizations/guarded-cubical/Semantics/Concrete/DoublePosetSemantics/Terms.agda @@ -0,0 +1,274 @@ +{-# OPTIONS --cubical --rewriting --guarded #-} + +{-# OPTIONS --lossy-unification #-} + +{-# OPTIONS --profile=constraints #-} + + +open import Common.Later + + +module Semantics.Concrete.DoublePosetSemantics.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 Semantics.Concrete.DoublePoset.Base +open import Semantics.Concrete.DoublePoset.Convenience +open import Semantics.Concrete.DoublePoset.Morphism +open import Semantics.Concrete.DoublePoset.Constructions +open import Semantics.Concrete.DoublePoset.DPMorRelation +open import Semantics.Concrete.DoublePoset.DblPosetCombinators + hiding (S) renaming (Comp to Compose) +open import Semantics.Lift k renaming (θ to θL ; ret to Return) +open import Semantics.Concrete.DoublePoset.DblDyn k +open import Semantics.Concrete.DoublePoset.LockStepErrorBisim k +-- open import Semantics.RepresentationSemantics k + +-- open import Semantics.Concrete.RepresentableRelation k +open LiftDoublePoset +open ClockedCombinators k renaming (Δ to Del) + +private + variable + â„“ â„“' : Level +-- todo: doubleposet + +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 + + {-# NON_COVERING #-} + ⟦_⟧ty : Ty → DoublePoset â„“-zero â„“-zero â„“-zero + ⟦ nat ⟧ty = â„• + ⟦ dyn ⟧ty = DynP + ⟦ S ⇀ T ⟧ty = ⟦ S ⟧ty ==> 𕃠(⟦ T ⟧ty) + + -- Typing context interpretation + {-# NON_COVERING #-} + ⟦_⟧ctx : Ctx -> DoublePoset â„“-zero â„“-zero â„“-zero -- Ctx → ð“œ.cat .ob + ⟦ [] ⟧ctx = UnitDP -- ð“œ.🙠+ ⟦ A ∷ Γ ⟧ctx = ⟦ Γ ⟧ctx ×dp ⟦ A ⟧ty -- ⟦ Γ ⟧ctx ð“œ.× ⟦ A ⟧ty + + {-# NON_COVERING #-} + ⟦_⟧S : Subst Δ Γ → DPMor ⟦ Δ ⟧ctx ⟦ Γ ⟧ctx -- ð“œ.cat [ ⟦ Δ ⟧ctx , ⟦ Γ ⟧ctx ] + + {-# NON_COVERING #-} + ⟦_⟧V : Val Γ S → DPMor ⟦ Γ ⟧ctx ⟦ S ⟧ty -- ð“œ.cat [ ⟦ Γ ⟧ctx , ⟦ S ⟧ty ] + + {-# NON_COVERING #-} + ⟦_⟧E : EvCtx Γ R S → DPMor (⟦ Γ ⟧ctx ×dp ⟦ R ⟧ty) (𕃠⟦ S ⟧ty) -- ??? + -- ð“œ.Linear ⟦ Γ ⟧ctx [ ⟦ R ⟧ty , ⟦ S ⟧ty ] + + {-# NON_COVERING #-} + ⟦_⟧C : Comp Γ S → DPMor ⟦ Γ ⟧ctx (𕃠⟦ S ⟧ty) -- ð“œ.ClLinear [ ⟦ Γ ⟧ctx , ⟦ S ⟧ty ] + + -- Substitutions + ⟦ ids ⟧S = MonId -- ð“œ.cat .id + ⟦ γ ∘s δ ⟧S = mCompU ⟦ γ ⟧S ⟦ δ ⟧S -- ⟦ γ ⟧S ∘⟨ ð“œ.cat ⟩ ⟦ δ ⟧S + ⟦ ∘IdL {γ = γ} i ⟧S = eqDPMor (mCompU MonId ⟦ γ ⟧S) ⟦ γ ⟧S refl i -- eqDPMor (mCompU MonId ⟦ γ ⟧S) ⟦ γ ⟧S refl i -- ð“œ.cat .⋆IdR ⟦ γ ⟧S i + ⟦ ∘IdR {γ = γ} i ⟧S = eqDPMor (mCompU ⟦ γ ⟧S MonId) ⟦ γ ⟧S refl i -- eqDPMor (mCompU ⟦ γ ⟧S MonId) ⟦ γ ⟧S refl i -- ð“œ.cat .⋆IdL ⟦ γ ⟧S i + ⟦ ∘Assoc {γ = γ}{δ = δ}{θ = θ} i ⟧S = + eqDPMor (mCompU ⟦ γ ⟧S (mCompU ⟦ δ ⟧S ⟦ θ ⟧S)) (mCompU (mCompU ⟦ γ ⟧S ⟦ δ ⟧S) ⟦ θ ⟧S) refl i + -- ð“œ.cat .⋆Assoc ⟦ θ ⟧S ⟦ δ ⟧S ⟦ γ ⟧S i + ⟦ !s ⟧S = UnitDP! -- ð“œ.!t + ⟦ []η {γ = γ} i ⟧S = eqDPMor ⟦ γ ⟧S UnitDP! refl i -- ð“œ.ðŸ™Î· ⟦ γ ⟧S i + ⟦ γ ,s V ⟧S = PairFun ⟦ γ ⟧S ⟦ V ⟧V -- ⟦ γ ⟧S ð“œ.,p ⟦ V ⟧V + ⟦ wk ⟧S = Ï€1 -- ð“œ.π₠+ ⟦ wkβ {δ = γ}{V = V} i ⟧S = + eqDPMor (mCompU Ï€1 (PairFun ⟦ γ ⟧S ⟦ V ⟧V)) ⟦ γ ⟧S refl i -- -- ð“œ.×β₠{f = ⟦ γ ⟧S}{g = ⟦ V ⟧V} i + ⟦ ,sη {δ = γ} i ⟧S = + eqDPMor ⟦ γ ⟧S (PairFun (mCompU Ï€1 ⟦ γ ⟧S) (mCompU Ï€2 ⟦ γ ⟧S)) refl i -- -- ð“œ.×η {f = ⟦ γ ⟧S} i + ⟦ isSetSubst γ γ' p q i j ⟧S = + DPMorIsSet ⟦ γ ⟧S ⟦ γ' ⟧S (cong ⟦_⟧S p) (cong ⟦_⟧S q) i j -- follows because MonFun is a set + + + -- Values + ⟦ V [ γ ]v ⟧V = mCompU ⟦ V ⟧V ⟦ γ ⟧S + ⟦ substId {V = V} i ⟧V = + eqDPMor (mCompU ⟦ V ⟧V MonId) ⟦ V ⟧V refl i + ⟦ substAssoc {V = V}{δ = δ}{γ = γ} i ⟧V = + eqDPMor (mCompU ⟦ V ⟧V (mCompU ⟦ δ ⟧S ⟦ γ ⟧S)) + (mCompU (mCompU ⟦ V ⟧V ⟦ δ ⟧S) ⟦ γ ⟧S) + refl i + ⟦ var ⟧V = Ï€2 + ⟦ varβ {δ = γ}{V = V} i ⟧V = + eqDPMor (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 = eqDPMor + ⟦ V ⟧V + (Curry (mCompU (mCompU (mCompU App Ï€2) PairAssocLR) + (PairFun (PairFun UnitDP! (mCompU ⟦ V ⟧V Ï€1)) Ï€2))) + (funExt (λ ⟦Γ⟧ -> eqDPMor _ _ refl)) i + ⟦ isSetVal V V' p q i j ⟧V = + DPMorIsSet ⟦ V ⟧V ⟦ V' ⟧V (cong ⟦_⟧V p) (cong ⟦_⟧V q) i j + + + -- 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 = + eqDPMor (mExt' _ (mCompU mRet Ï€2) ∘m ⟦ E ⟧E) ⟦ E ⟧E (funExt (λ x → monad-unit-r (DPMor.f ⟦ E ⟧E x))) i + ⟦ ∘IdR {E = E} i ⟧E = + eqDPMor (mExt' _ ⟦ E ⟧E ∘m mCompU mRet Ï€2) ⟦ E ⟧E (funExt (λ x → monad-unit-l _ _)) i + ⟦ ∘Assoc {E = E}{F = F}{F' = F'} i ⟧E = + eqDPMor (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 = eqDPMor (mCompU ⟦ E ⟧E (PairFun (mCompU MonId Ï€1) Ï€2)) ⟦ E ⟧E refl i + ⟦ substAssoc {E = E}{γ = γ}{δ = δ} i ⟧E = + eqDPMor (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 eqDPMor below leads to an error when lossy unification is turned on. + -- This seems to be fixed by using congS η refl + ⟦ ∙substDist {γ = γ} i ⟧E = eqDPMor + (mCompU (mCompU mRet Ï€2) + (PairFun (mCompU ⟦ γ ⟧S Ï€1) Ï€2)) (mCompU mRet Ï€2) + (funExt (λ {(⟦Γ⟧ , ⟦R⟧) -> congS η refl})) i + ⟦ ∘substDist {E = E}{F = F}{γ = γ} i ⟧E = + eqDPMor (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 = + eqDPMor ⟦ E ⟧E (Bind (⟦ Γ ⟧ctx ×dp ⟦ R ⟧ty) + (mCompU (mCompU mRet Ï€2) (PairFun UnitDP! Ï€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 = DPMorIsSet ⟦ 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 + + + matchNat-helper : {â„“X â„“'X â„“''X â„“Y â„“'Y â„“''Y : Level} {X : DoublePoset â„“X â„“'X â„“''X} {Y : DoublePoset â„“Y â„“'Y â„“''Y} -> + DPMor X Y -> DPMor (X ×dp â„•) Y -> DPMor (X ×dp â„•) Y + matchNat-helper fZ fS = + record { f = λ { (Γ , zero) → DPMor.f fZ Γ ; + (Γ , suc n) → DPMor.f fS (Γ , n) } ; + isMon = λ { {Γ1 , zero} {Γ2 , zero} (Γ1≤Γ2 , n1≤n2) → DPMor.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) → DPMor.isMon fS (Γ1≤Γ2 , injSuc n1≤n2)} ; + pres≈ = λ { {Γ1 , zero} {Γ2 , zero} (Γ1≈Γ2 , n1≈n2) → DPMor.pres≈ 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) → DPMor.pres≈ fS (Γ1≈Γ2 , injSuc n1≈n2) } + } + + + -- Computations + ⟦ _[_]∙ {Γ = Γ} E M ⟧C = Bind ⟦ Γ ⟧ctx ⟦ M ⟧C ⟦ E ⟧E + ⟦ plugId {M = M} i ⟧C = + eqDPMor (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 = + eqDPMor (Bind _ ⟦ M ⟧C (mExt' _ ⟦ F ⟧E ∘m ⟦ E ⟧E)) + (Bind _ (Bind _ ⟦ M ⟧C ⟦ E ⟧E) ⟦ F ⟧E) + (funExt (λ ⟦Γ⟧ → sym (monad-assoc + (λ z → DPMor.f ⟦ E ⟧E (⟦Γ⟧ , z)) + (DPMor.f (Ï€2 .DPMor.f (⟦Γ⟧ , U (Curry ⟦ F ⟧E) ⟦Γ⟧))) + (DPMor.f ⟦ M ⟧C ⟦Γ⟧)))) + i + ⟦ M [ γ ]c ⟧C = mCompU ⟦ M ⟧C ⟦ γ ⟧S -- ⟦ M ⟧C ∘⟨ ð“œ.cat ⟩ ⟦ γ ⟧S + ⟦ substId {M = M} i ⟧C = + eqDPMor (mCompU ⟦ M ⟧C MonId) ⟦ M ⟧C refl i -- ð“œ.cat .⋆IdL ⟦ M ⟧C i + ⟦ substAssoc {M = M}{δ = δ}{γ = γ} i ⟧C = + eqDPMor (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 = + eqDPMor (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 = + eqDPMor (Bind _ (mCompU (K UnitDP ℧) UnitDP!) ⟦ E ⟧E) + (mCompU (K UnitDP ℧) UnitDP!) + (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 = eqDPMor (Bind (⟦ Γ ⟧ctx ×dp ⟦ T ⟧ty) + (mCompU (mCompU mRet Ï€2) (PairFun UnitDP! Ï€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 = + eqDPMor (mCompU (mCompU (mCompU App Ï€2) PairAssocLR) + (PairFun (PairFun UnitDP! (mCompU (Curry ⟦ M ⟧C) Ï€1)) Ï€2)) + ⟦ M ⟧C refl i + ⟦ matchNat Mz Ms ⟧C = matchNat-helper ⟦ Mz ⟧C ⟦ Ms ⟧C + ⟦ matchNatβz Mz Ms i ⟧C = eqDPMor + (mCompU (matchNat-helper ⟦ Mz ⟧C ⟦ Ms ⟧C) + (PairFun MonId (mCompU Zero UnitDP!))) + ⟦ Mz ⟧C + refl i + ⟦ matchNatβs Mz Ms i ⟧C = eqDPMor + (mCompU (matchNat-helper ⟦ Mz ⟧C ⟦ Ms ⟧C) + (PairFun Ï€1 (mCompU Suc (PairFun UnitDP! Ï€2)))) + ⟦ Ms ⟧C refl i + ⟦ matchNatη {M = M} i ⟧C = eqDPMor + ⟦ M ⟧C + (matchNat-helper + (mCompU ⟦ M ⟧C (PairFun MonId (mCompU Zero UnitDP!))) + (mCompU ⟦ M ⟧C (PairFun Ï€1 (mCompU Suc (PairFun UnitDP! Ï€2))))) + (funExt (λ { (⟦Γ⟧ , zero) → refl ; + (⟦Γ⟧ , suc n) → refl})) + i + ⟦ isSetComp M N p q i j ⟧C = DPMorIsSet ⟦ 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 +