Skip to content

Commit

Permalink
add propositional IF algebras
Browse files Browse the repository at this point in the history
  • Loading branch information
javra committed Dec 9, 2020
1 parent 8486339 commit 773d249
Show file tree
Hide file tree
Showing 3 changed files with 129 additions and 7 deletions.
18 changes: 17 additions & 1 deletion AME.agda
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,10 @@ record Con : Set₂ where
ᴾᴬ : Set₁
Ec : S.SCon
E : S.Con Ec
wc : {γc}(γ : _ᵃC {zero} E γc) S.SCon
w : {γc}(γ : (E ᵃC) γc) S.Con (wc γ)
Rc : {γc}(γ : _ᵃC {zero} E γc)(γᴬ : ᴬ) S.SCon
R : {γc}(γ : (E ᵃC) γc)(γᴬ : ᴬ) S.Con (Rc γ γᴬ)

record TyS: Con) : Set₂ where
no-eta-equality
Expand All @@ -39,6 +43,8 @@ record TyS (Γ : Con) : Set₂ where
: Γ.ᴬ Set₁
: {γᴬ δᴬ} Γ.ᴹ γᴬ δᴬ ᴬ γᴬ ᴬ δᴬ Set
ᴾᴬ : Γ.ᴾᴬ Set₁
w : (γc : _ᵃc {zero} Γ.Ec) Set S.TyS
R : {γᴬ}(α : Set)(αᴬ : ᴬ γᴬ) S.TyS

record TyP: Con) : Set₂ where
module Γ = Con Γ
Expand All @@ -47,6 +53,8 @@ record TyP (Γ : Con) : Set₂ where
: {γᴬ δᴬ} Γ.ᴹ γᴬ δᴬ ᴬ γᴬ ᴬ δᴬ Set₁
ᴾᴬ : Γ.ᴾᴬ Prop
E : S.TyP Γ.Ec
w : {γc}(γ : (Γ.E ᵃC) γc) (E ᵃP) γc S.TyP (Γ.wc γ)
R : {γc}(γ : (Γ.E ᵃC) γc){γᴬ : Γ.ᴬ}(α : (E ᵃP) γc)(αᴬ : ᴬ γᴬ) S.TyP (Γ.Rc γ γᴬ)

Ty :: Con) (k : PS) Set₂
Ty Γ P = TyP Γ
Expand All @@ -60,6 +68,8 @@ record TmS (Γ : Con) (B : TyS Γ) : Set₂ where
: {γᴬ δᴬ}(γᴹ : Γ.ᴹ γᴬ δᴬ) B.ᴹ γᴹ (ᴬ γᴬ) (ᴬ δᴬ)
ᴾᴬ : (γᴾᴬ : Γ.ᴾᴬ) B.ᴾᴬ γᴾᴬ
E : S.Tm Γ.Ec S.U
w : {γc}(γ : (Γ.E ᵃC) γc) S.Tm (Γ.wc γ) (B.w γc ((E ᵃt) γc))
R : {γc}(γ : (Γ.E ᵃC) γc)(γᴬ : Γ.ᴬ) S.Tm (Γ.Rc γ γᴬ) (B.R ((E ᵃt) γc) (ᴬ γᴬ))

record TmP: Con) (A : TyP Γ) : Set₂ where
module Γ = Con Γ
Expand All @@ -69,6 +79,8 @@ record TmP (Γ : Con) (A : TyP Γ) : Set₂ where
: {γᴬ δᴬ}(γᴹ : Γ.ᴹ γᴬ δᴬ) A.ᴹ γᴹ (ᴬ γᴬ) (ᴬ δᴬ)
ᴾᴬ : (γᴾᴬ : Γ.ᴾᴬ) A.ᴾᴬ γᴾᴬ
E : {γc} _ᵃC {zero} Γ.E γc (A.E ᵃP) γc
w : {γc}(γ : (Γ.E ᵃC) γc){δc : _ᵃc {zero} (Γ.wc γ)} (Γ.w γ ᵃC) δc S.TmP (Γ.w γ) (A.w γ (E γ))
R : {γc}(γ : (Γ.E ᵃC) γc)(γᴬ : Γ.ᴬ){δc}(δ : _ᵃC {zero} (Γ.R γ γᴬ) δc) S.TmP (Γ.R γ γᴬ) (A.R γ (E γ) (ᴬ γᴬ))

Tm : {k : PS} : Con) (A : Ty Γ k) Set₂
Tm {P} = TmP
Expand All @@ -89,7 +101,11 @@ record Sub (Γ : Con) (Δ : Con) : Set₂ where
= λ _ _ Lift _ ⊤ ;
ᴾᴬ = Lift _ ⊤ ;
Ec = S.∙c ;
E = S.∙ }
E = S.∙ ;
wc = λ _ S.∙c ;
w = λ _ S.∙ ;
Rc = λ _ _ S.∙c ;
R = λ _ _ S.∙ }

_▶S_ :: Con) TyS Γ Con
Γ ▶S B = record { ᴬ = Σ Γ.ᴬ B.ᴬ ;
Expand Down
16 changes: 10 additions & 6 deletions EWRSg.agda
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
{-# OPTIONS --rewriting --allow-unsolved-metas #-}
{-# OPTIONS --prop --rewriting --allow-unsolved-metas #-}
module EWRSg where

open import Lib hiding (id; _∘_)
open import II using (PS; P; S)
--open import II using (PS; P; S)
--import IIA as IIA
import IF as S
open import IFA
Expand All @@ -22,6 +22,10 @@ infixl 3 _▶_
infixl 3 _▶S_
infixl 3 _▶P_

data PS : Set where
P : PS
S : PS

record Con : Set₂ where
field
: Set₁
Expand Down Expand Up @@ -221,8 +225,8 @@ El {Γ} a = record { ᴬ = λ γᴬ → a.ᴬ γᴬ ;
ΠS :: Con} (a : TmS Γ U) (B : TyS (Γ ▶P El a)) TyS Γ
ΠS {Γ} a B = record { ᴬ = λ γᴬ : a.ᴬ γᴬ) B.ᴬ (γᴬ , α) ;
= λ {γᴬ} γᴹ πᴬ ϕᴬ (αᴬ : a.ᴬ γᴬ) B.ᴹ (γᴹ , lift refl) (πᴬ αᴬ) (ϕᴬ (a.ᴹ γᴹ αᴬ)) ;
w = λ γc πᴱ S.Π̂S ((a.E ᵃt) γc) λ α B.w γc πᴱ ;
R = λ {γᴬ} πᴱ πᴬ S.Π̂S (a.ᴬ γᴬ) λ αᴬ B.R πᴱ (πᴬ αᴬ) ;
w = λ γc πᴱ ? ; --S.Π̂S ((a.E ᵃt) γc) λ α → B.w γc πᴱ ;
R = λ {γᴬ} πᴱ πᴬ ? ; --S.Π̂S (a.ᴬ γᴬ) λ αᴬ → B.R πᴱ (πᴬ αᴬ) ;
F = λ {γc} γ γᴬ {ρc} ρ π πᴬ πᴿ
(xᴱ : (a.E ᵃt) γc)(xᴬ : a.ᴬ γᴬ)(xᴿ : (a.R γ γᴬ ᵃt) ρc xᴬ xᴱ)
B.F (γ , xᴱ) (γᴬ , xᴬ) (ρ , xᴿ) π (πᴬ xᴬ) (πᴿ xᴬ) ;
Expand Down Expand Up @@ -356,7 +360,7 @@ appP {a = a}{B} f = record { ᴬ = λ { (γ , α) → f.ᴬ γ α } ;
module a = TmS a
module B = TyP B
module f = TmP f

{-
--External function type
Π̂S : {Γ : Con} (T : Set) (B : T → TyS Γ) → TyS Γ
Π̂S T B = record { ᴬ = λ γᴬ → (τ : T) → TyS.ᴬ (B τ) γᴬ ;
Expand All @@ -378,7 +382,7 @@ appP {a = a}{B} f = record { ᴬ = λ { (γ , α) → f.ᴬ γ α } ;
sg = λ γ δ πᴱ πᴬ τ TyP.sg (A τ) γ δ (πᴱ τ) (πᴬ τ)
{- m = λ γ γᴬ δ ρ γᶠ τ' π πᴬ πʷ πᴿ τ
→ TyP.m (A τ) γ γᴬ δ ρ γᶠ τ' (π τ) (πᴬ τ) (πʷ τ) (πᴿ τ) -} }

-}
âppS :: Con} {T : Set} {B : T TyS Γ} (f : TmS Γ (Π̂S T B)) (τ : T) TmS Γ (B τ)
âppS {Γ}{T}{B} f τ = record { ᴬ = λ γᴬ f.ᴬ γᴬ τ ;
= λ γᴹ f.ᴹ γᴹ τ ;
Expand Down
102 changes: 102 additions & 0 deletions IFPA.agda
Original file line number Diff line number Diff line change
@@ -0,0 +1,102 @@
{-# OPTIONS --prop --rewriting #-}
module IFPA where

open import Lib hiding (id; _∘_)
open import StrictLib
open import IF

_ᵖᵃS : {ℓ} TyS Set (suc ℓ)
_ᵖᵃS {ℓ} U = Prop
_ᵖᵃS {ℓ} (T ⇒̂S B) = T _ᵖᵃS {ℓ} B

_ᵖᵃc : {ℓ} SCon Set (suc ℓ)
∙c ᵖᵃc = Lift _ ⊤
_ᵖᵃc {ℓ} (Γc ▶c B) = (_ᵖᵃc {ℓ} Γc) × _ᵖᵃS {ℓ} B

_ᵖᵃt : {ℓ Γc B} Tm Γc B _ᵖᵃc {ℓ} Γc _ᵖᵃS {ℓ} B
(var vvz ᵖᵃt) (γ , α) = α
(var (vvs t) ᵖᵃt) (γ , α) = (var t ᵖᵃt) γ
((t $S α) ᵖᵃt) γ = (t ᵖᵃt) γ α

_ᵖᵃP : {ℓ Γc} TyP Γc _ᵖᵃc {ℓ} Γc Prop
(El a ᵖᵃP) γ = (a ᵖᵃt) γ
(Π̂P T A ᵖᵃP) γ =: T) ((A τ) ᵖᵃP) γ
((a ⇒P A) ᵖᵃP) γ = (a ᵖᵃt) γ (A ᵖᵃP) γ

_ᵖᵃC : {ℓ Γc} Con Γc _ᵖᵃc {ℓ} Γc Prop
(∙ ᵖᵃC) γ = P⊤
((Γ ▶P A) ᵖᵃC) γ = (Γ ᵖᵃC) γ ∧ (A ᵖᵃP) γ

_ᵖᵃs : {ℓ}{Γc Δc} Sub Γc Δc _ᵖᵃc {ℓ} Γc _ᵖᵃc {ℓ} Δc
(ε ᵖᵃs) γ = lift tt
((σ , t) ᵖᵃs) γ = (σ ᵖᵃs) γ , (t ᵖᵃt) γ

[]tᵖᵃ : {ℓ Γc Δc B}{t : Tm Δc B}{σ : Sub Γc Δc}
(γc : _ᵖᵃc {ℓ} Γc) ((t [ σ ]t) ᵖᵃt) γc ≡ (t ᵖᵃt) ((σ ᵖᵃs) γc)
[]tᵖᵃ {t = var vvz} {σ , x} γc = refl
[]tᵖᵃ {t = var (vvs a)}{σ , x} γc = []tᵖᵃ {t = var a} γc
[]tᵖᵃ {t = t $S α} {σ} γc = happly ([]tᵖᵃ {t = t} γc) α
{-# REWRITE []tᵖᵃ #-}

[]Tᵖᵃ : {ℓ Γc Δc A}{σ : Sub Γc Δc} (γc : _ᵖᵃc {ℓ} Γc) ((A [ σ ]T) ᵖᵃP) γc ≡ (A ᵖᵃP) ((σ ᵖᵃs) γc)
[]Tᵖᵃ {A = El a} γc = []tᵖᵃ {t = a} γc
[]Tᵖᵃ {A = Π̂P T A} γc = PΠ≡ refl λ τ []Tᵖᵃ {A = A τ} γc
[]Tᵖᵃ {A = a ⇒P A} γc = (λ p _ p) & []Tᵖᵃ {A = A} γc
{-# REWRITE []Tᵖᵃ #-}

[]Cᵖᵃ : {ℓ Γc Δc}{σ : Sub Γc Δc}{Δ : Con Δc}{γc : _ᵖᵃc {ℓ} Γc} ((Δ [ σ ]C) ᵖᵃC) γc ≡ (Δ ᵖᵃC) ((σ ᵖᵃs) γc)
[]Cᵖᵃ {Δ = ∙} = refl
[]Cᵖᵃ {Δ = Δ ▶P A} = (λ p p ∧ _) & []Cᵖᵃ
{-# REWRITE []Cᵖᵃ #-}

vs,ᵖᵃ : {ℓ Γc B B'}{x : Tm Γc B}{γc}{α : _ᵖᵃS {ℓ} B'} (vs x ᵖᵃt) (γc , α) ≡ (x ᵖᵃt) γc
vs,ᵖᵃ {x = var x} = refl
vs,ᵖᵃ {x = x $S α} = happly (vs,ᵖᵃ {x = x}) α
{-# REWRITE vs,ᵖᵃ #-}

wk,ᵖᵃ : {ℓ Γc Δc B γc}{α : B ᵖᵃS}{σ : Sub Γc Δc} _ᵖᵃs {ℓ} (wk {B = B} σ) (γc , α) ≡ (σ ᵖᵃs) γc
wk,ᵖᵃ {σ = ε} = refl
wk,ᵖᵃ {σ = σ , t} = ,≡ wk,ᵖᵃ refl
{-# REWRITE wk,ᵖᵃ #-}

idᵖᵃ : {ℓ Γc} (γc : _ᵖᵃc {ℓ} Γc) (id ᵖᵃs) γc ≡ γc
idᵖᵃ {ℓ}{∙c} γc = refl
idᵖᵃ {ℓ}{Γc ▶c B} (γc , α) = ,≡ (idᵖᵃ γc) refl
{-# REWRITE idᵖᵃ #-}

wkid : {ℓ Γc B} γc _ᵖᵃs {ℓ} (wk {B = B} (id {Γc = Γc})) γc ≡ ₁ γc
wkid (γc , α) = refl
{-# REWRITE wkid #-}

∘ᵖᵃ : {ℓ Γc Δc Σc}{σ : Sub Δc Σc}{δ : Sub Γc Δc}{γc} _ᵖᵃs {ℓ} (σ ∘ δ) γc ≡ (σ ᵖᵃs) ((δ ᵖᵃs) γc)
∘ᵖᵃ {σ = ε} = refl
∘ᵖᵃ {σ = σ , t} {δ = δ}{γc = γc} = happly2 _,_ (∘ᵖᵃ {σ = σ} {δ = δ}) ((t ᵖᵃt) ((δ ᵖᵃs) γc))
{-# REWRITE ∘ᵖᵃ #-}

π₁ᵃ : {ℓ Γc Δc A}{σ : Sub Γc (Δc ▶c A)}{γc} _ᵖᵃs {ℓ} (π₁ σ) γc ≡ ₁ ((σ ᵖᵃs) γc)
π₁ᵃ {σ = σ , x} = refl
{-# REWRITE π₁ᵃ #-}

π₂ᵃ : {ℓ Γc Δc A}{σ : Sub Γc (Δc ▶c A)}{γc} _ᵖᵃt {ℓ} (π₂ σ) γc ≡ ₂ ((σ ᵖᵃs) γc)
π₂ᵃ {σ = σ , x} = refl
{-# REWRITE π₂ᵃ #-}
{-
Twkᵃ : ∀{ℓ Γc}{B A γc T} → _ᵖᵃP {ℓ} (Twk {Γc = Γc}{B = B} A) (γc , T) ≡ _ᵖᵃP A γc
Twkᵃ {A = El x} = refl
Twkᵃ {A = Π̂P T B} = Π≡ refl λ τ → Twkᵃ {A = B τ}
Twkᵃ {A = a ⇒P A} = Π≡ refl λ α → Twkᵃ {A = A}
{-# REWRITE Twkᵃ #-}
-}

_ᵖᵃtP : {ℓ Γc}{Γ : Con Γc}{A}(tP : TmP Γ A){γc}(γ : _ᵖᵃC {ℓ} Γ γc) _ᵖᵃP {ℓ} A γc
(varP vvzP ᵖᵃtP) (γ , α) = α
(varP (vvsP x) ᵖᵃtP) (γ , α) = (varP x ᵖᵃtP) γ
((tP $P sP) ᵖᵃtP) γ = (tP ᵖᵃtP) γ ((sP ᵖᵃtP) γ)
((tP $̂P τ) ᵖᵃtP) γ = (tP ᵖᵃtP) γ τ

_ᵖᵃsP : {ℓ Γc}{Γ Δ : Con Γc}(σP : SubP Γ Δ){γc}
_ᵖᵃC {ℓ} Γ γc _ᵖᵃC {ℓ} Δ γc
(εP ᵖᵃsP) γ = ptt
((σP ,P tP) ᵖᵃsP) γ = (σP ᵖᵃsP) γ , (tP ᵖᵃtP) γ

--TODO define ∘Pᵃ, π₁Pᵃ, π₂Pᵃ

0 comments on commit 773d249

Please sign in to comment.