{-# OPTIONS --cumulativity #-}
module ROmega.Examples.Section-3 where
open import Agda.Primitive
open import Level
open import Data.Product
renaming (proj₁ to fst; proj₂ to snd)
hiding (Σ)
import Relation.Binary.PropositionalEquality as Eq
open Eq using (_≡_; refl; sym)
open import Data.String
open import Data.Unit.Polymorphic
open import Data.Fin renaming (zero to fzero ; suc to fsuc)
open import ROmega.Entailment
open import ROmega.Entailment.Reasoning
open import ROmega.Types hiding (U)
open import ROmega.Types.Substitution
open import ROmega.Types.Substitution.Properties
open import ROmega.Equivalence
open import ROmega.Terms
idω : ∀ {ℓ ℓΔ} {Δ : KEnv ℓΔ} → Ty Δ ((★ ℓ) `→ (★ ℓ))
idω {ℓ} = `λ (★ ℓ) (tvar Z)
selT : ∀ {ℓ ℓΔ} {Δ : KEnv ℓΔ} → Ty Δ (★ (lsuc ℓ))
selT {ℓ} =
`∀ L (`∀ (★ ℓ) (`∀ R[ ★ ℓ ]
(((Ł R▹ T) ≲ ζ) ⇒ (Π ζ) `→ ⌊ Ł ⌋ `→ T)))
where
ζ = tvar Z
T = tvar (S Z)
Ł = tvar (S (S Z))
sel : ∀ {ℓ ℓΔ ℓφ ℓΓ} {Δ : KEnv ℓΔ} {φ : PEnv Δ ℓφ} {Γ : Env Δ ℓΓ} → Tm Δ φ Γ (selT {ℓ})
sel {ℓ} = `Λ L (`Λ (★ ℓ) (`Λ R[ (★ ℓ) ]
(`ƛ ((Ł R▹ T) ≲ ζ) (`λ (Π ζ) (`λ ⌊ Ł ⌋ body)))))
where
ζ = tvar Z
T = tvar (S Z)
Ł = tvar (S (S Z))
body = (prj▹ (var (S Z)) (n-var Z)) / (var Z)
conT : ∀ {ℓ ℓΔ} {Δ : KEnv ℓΔ} → Ty Δ (★ (lsuc ℓ))
conT {ℓ} =
`∀ (L {lzero}) (`∀ (★ ℓ) (`∀ R[ (★ ℓ) ]
(((l R▹ t) ≲ z) ⇒ ⌊ l ⌋ `→ t `→ Σ z)))
where
z = tvar Z
t = tvar (S Z)
l = tvar (S (S Z))
con : ∀ {ℓ ℓΔ ℓφ ℓΓ} {Δ : KEnv ℓΔ} {φ : PEnv Δ ℓφ} {Γ : Env Δ ℓΓ} → Tm Δ φ Γ (conT {ℓ})
con {ℓ} = `Λ L (`Λ (★ ℓ) (`Λ R[ (★ ℓ) ]
(`ƛ ((l R▹ t) ≲ z) ((`λ (⌊ l ⌋) (`λ t Σz))))))
where
z = tvar Z
t = tvar (S Z)
l = tvar (S (S Z))
x = var Z
l' = var (S Z)
Σz = inj▹ (l' ▹ x) (n-var Z)
con₁ con₂ : ⟦ conT ⟧t tt
con₁ _ t z π ρ x with π fzero
... | n , eq rewrite eq = n , x
con₂ = ⟦ con ⟧ tt tt tt
con-ext-eq : ∀ u X z π ρ u' → con₁ u X z π ρ u' ≡ con₂ u X z π ρ u'
con-ext-eq _ X row π r _ with π fzero
... | m , eq rewrite eq = refl
caseT : ∀ {ℓ ℓΔ} {Δ : KEnv ℓΔ} → Ty Δ (★ (lsuc ℓ))
caseT {ℓ} = `∀ L (`∀ (★ ℓ)(`∀ (★ ℓ)
(⌊ l ⌋ `→ ((t `→ u)) `→ ((Σ (l R▹ t)) `→ u))))
where
l = tvar (S (S Z))
t = tvar (S Z)
u = tvar Z
case : ∀ {ℓ ℓΔ ℓΦ ℓΓ} {Δ : KEnv ℓΔ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ} →
Tm Δ Φ Γ (caseT {ℓ})
case {ℓ} = `Λ L (`Λ (★ ℓ) (`Λ (★ ℓ)
(`λ ⌊ Ł ⌋ (`λ (T `→ U) (`λ (Σ (Ł R▹ T)) (f · ((Σ⁻¹ x) / l)))))))
where
Ł = tvar (S (S Z))
T = tvar (S Z)
U = tvar Z
l = var (S (S Z))
f = var (S Z)
x = var Z
Tru Fls : ∀ {ℓΔ} {Δ : KEnv ℓΔ} →
Ty Δ L
Tru = lab "True"
Fls = lab "False"
BoolP : ∀ {ℓ ℓΔ} {Δ : KEnv ℓΔ} → Pred (Δ , R[ ★ ℓ ]) (★ ℓ)
BoolP = ((Tru R▹ ∅) · Fls R▹ ∅ ~ tvar Z)
Bool : ∀ {ℓ} {ℓΔ} {Δ : KEnv ℓΔ} →
Ty Δ (★ (lsuc ℓ))
Bool {ℓ} = `∀ (R[ ★ ℓ ]) (BoolP ⇒ Σ (tvar Z))
ifteT : ∀ {ℓ} {ℓΔ} {Δ : KEnv ℓΔ} →
Ty Δ (★ (lsuc ℓ))
ifteT {ℓ} = `∀ (★ ℓ)
(`∀ R[ ★ ℓ ] ((BoolP {ℓ}) ⇒ ((Bool {ℓ}) `→ ((tvar (S Z)) `→ ((tvar (S Z)) `→ (tvar (S Z)))))))
ifte : ∀ {ℓ ℓΔ ℓφ ℓΓ} {Δ : KEnv ℓΔ} {φ : PEnv Δ ℓφ} {Γ : Env Δ ℓΓ} →
Tm Δ φ Γ (ifteT {ℓ})
ifte =
`Λ (★ _)
(`Λ R[ ★ _ ]
(`ƛ _
(`λ Bool
(`λ (tvar (S Z))
(`λ (tvar (S Z))
((((((((case ·[ Tru ]) ·[ ∅ ]) ·[ _ ]) · lab Tru) · `λ _ (var (S (S Z)))))
▿
((((((case ·[ Fls ]) ·[ ∅ ]) ·[ _ ]) · lab Fls) · `λ _ (var (S Z)))))
(n-var Z) · (((var (S (S Z))) ·[ tvar Z ]) ·⟨ n-var Z ⟩) ))))))
reifyT : Ty ε ★₁
reifyT = `∀ R[ ★₀ ] (`∀ ★₀ (((Σ z) `→ t) `→ Π (⌈ (`λ ★₀ ((tvar Z) `→ (tvar (S Z)))) ⌉· z)))
where
t = tvar Z
z = tvar (S Z)
reify : Tm ε ε ε reifyT
reify = `Λ R[ ★₀ ] (`Λ ★₀ (`λ (((Σ z) `→ t)) (syn z (`λ ★₀ ((tvar Z) `→ (tvar (S Z)))) sbod)))
where
t = tvar Z
z = tvar (S Z)
sbod = `Λ (L {lzero}) (`Λ ★₀ (`Λ R[ ★₀ ] (`ƛ ((l R▹ u) · y ~ z')
(`λ ⌊ l ⌋
(t-≡
(`λ u
(f ·
((((((con ·[ l ]) ·[ u ]) ·[ z' ])
·⟨ n-·≲L (n-var Z) ⟩)
· (var (S Z)))
· (var Z))))
(teq-sym teq-β))))))
where
y = tvar Z
u = tvar (S Z)
l = tvar (S (S Z))
z' = tvar (S (S (S (S Z))))
f = var (S (S Z))
⟦reify⟧ : ⟦ reifyT ⟧t tt
⟦reify⟧ = ⟦ reify ⟧ tt tt tt
reflectT : Ty ε ★₁
reflectT = `∀ R[ ★₀ ] (`∀ ★₀
(Π (⌈ (`λ ★₀ ((tvar Z) `→ (tvar (S Z)))) ⌉· z) `→
((Σ (⌈ idω ⌉· z)) `→ t)))
where
t = tvar Z
z = tvar (S Z)
reflect : Tm ε ε ε reflectT
reflect =
`Λ R[ ★₀ ]
(`Λ ★₀
(`λ (Π (⌈ (`λ ★₀ (tvar Z `→ tvar (S Z))) ⌉· (tvar (S Z))))
(ana (tvar (S Z)) idω (tvar Z) M)))
where
M =
`Λ L
(`Λ ★₀
(`Λ R[ ★₀ ]
(`ƛ ((tvar (S (S Z)) R▹ tvar (S Z)) · (tvar Z) ~ (tvar (S (S (S (S Z))))))
(`λ ⌊ (tvar (S (S Z))) ⌋
(`λ (idω ·[ tvar (S Z) ])
body)))))
where
body =
((((((sel
·[ tvar (S (S Z)) ])
·[ idω ·[ tvar (S Z) ] `→ (tvar (S (S (S Z)))) ])
·[ (⌈ (`λ ★₀ (tvar Z `→ tvar (S (S (S (S Z)))))) ⌉· (tvar (S (S (S (S Z)))))) ])
·⟨ evidence ⟩)
· var (S (S Z)))
· (var (S Z )))
· (var Z)
where
Ł = tvar (S (S Z))
T = (tvar (S (S (S Z))))
T' = (tvar (S (S (S (S Z)))))
Uu = tvar (S Z)
Y = tvar Z
ζ = tvar (S (S (S (S Z))))
evidence : Ent _ _ ((Ł R▹ ((idω ·[ Uu ]) `→ T)) ≲ ⌈ (`λ ★₀ (tvar Z `→ T')) ⌉· ζ)
evidence =
(((Ł R▹ Uu) · Y ~ ζ)
⊩⟨ n-·≲L ⟩
((Ł R▹ Uu) ≲ ζ)
⊩⟨ n-≡ (peq-≲ (teq-sing teq-refl (teq-sym teq-β)) teq-refl) ⟩
((Ł R▹ (idω ·[ Uu ])) ≲ ζ)
⊩⟨ n-≲lift₂ ⟩
((⌈ (`λ ★₀ (tvar Z `→ T')) ⌉· (Ł R▹ (idω ·[ Uu ])) ≲ ⌈ (`λ ★₀ (tvar Z `→ T')) ⌉· ζ))
⊩⟨ n-≡ (peq-≲ teq-lift₂ teq-refl) ⟩
(((Ł R▹ ((`λ ★₀ (tvar Z `→ T')) ·[ (idω ·[ Uu ]) ])) ≲ ⌈ (`λ ★₀ (tvar Z `→ T')) ⌉· ζ))
⊩⟨ n-≡ (peq-≲ (teq-sing teq-refl teq-β) teq-refl) ⟩
∎)
(n-var Z)
Iter : ∀ {Δ : KEnv lzero} →
(κ : Kind lzero) →
Ty Δ (κ `→ ★₀) →
Ty Δ (κ `→ ★₀) →
Ty Δ (R[ κ ]) →
Ty Δ ★₁
Iter κ f g z =
`∀ L (`∀ κ (`∀ R[ κ ]
(((Ł R▹ U) · Y ~ (weaken (weaken (weaken z))) ⇒
⌊ Ł ⌋ `→ ((weaken (weaken (weaken f))) ·[ U ] `→ weaken (weaken (weaken g)) ·[ U ])))))
where
Ł = tvar (S (S Z))
U = tvar (S Z)
Y = tvar Z
map-ΠT : ∀ {Δ : KEnv lzero} →
(κ : Kind lzero) →
Ty Δ ★₁
map-ΠT κ =
`∀ R[ κ ] (`∀ (κ `→ ★₀) (`∀ (κ `→ ★₀)
(Iter κ f g z `→ (Π (⌈ f ⌉· z)) `→ Π (⌈ g ⌉· z) )))
where
g = tvar Z
f = tvar (S Z)
z = tvar (S (S Z))
map-Π : ∀ {Δ : KEnv lzero} {Φ : PEnv Δ lzero} {Γ : Env Δ lzero} →
(κ : Kind lzero) →
Tm Δ Φ Γ (map-ΠT κ)
map-Π κ =
`Λ R[ κ ]
(`Λ (κ `→ ★₀)
(`Λ (κ `→ ★₀)
(`λ (Iter κ (tvar (S Z)) (tvar Z) (tvar (S (S Z))))
(`λ (Π (⌈ f ⌉· tvar (S (S Z))))
(syn (tvar (S (S Z))) (tvar Z)
(`Λ L
(`Λ κ
(`Λ R[ κ ]
(`ƛ ((tvar (S (S Z)) R▹ tvar (S Z)) · (tvar Z) ~ tvar (S (S (S (S (S Z))))))
(`λ ⌊ tvar (S (S Z)) ⌋
((i' · l) · ((sel' · r) · l)))
)))))))))
where
f = tvar (S Z)
l = var Z
r = var (S Z)
i' = let
Ł = tvar (S (S Z))
U = tvar (S Z)
Y = tvar Z
in ((((var (S (S Z))) ·[ Ł ]) ·[ U ]) ·[ Y ]) ·⟨ n-var Z ⟩
sel' = let
Ł = tvar (S (S Z))
U = tvar (S Z)
z' = tvar (S (S (S (S (S Z)))))
f' = tvar (S (S (S (S Z))))
in
(((sel
·[ Ł ])
·[ f' ·[ U ] ])
·[ (⌈ f' ⌉· z') ])
·⟨ evidence ⟩
where
evidence : let
Ł = tvar (S (S Z))
U = tvar (S Z)
z' = tvar (S (S (S (S (S Z)))))
f' = tvar (S (S (S (S Z))))
in Ent _ _ ((Ł R▹ (f' ·[ U ]) ) ≲ (⌈ f' ⌉· z'))
evidence = let
Ł = tvar (S (S Z))
U = tvar (S Z)
Y = tvar Z
z' = tvar (S (S (S (S (S Z)))))
f' = tvar (S (S (S (S Z))))
in
((((Ł R▹ U) · Y ~ z')
⊩⟨ n-·≲L ⟩
((Ł R▹ U) ≲ z'
⊩⟨ n-≲lift₂ ⟩
⌈ f' ⌉· (Ł R▹ U ) ≲ ⌈ f' ⌉· z'
⊩⟨ n-≡ (peq-≲ teq-lift₂ teq-refl) ⟩
∎)) (n-var Z))
map-ΣT : ∀ {Δ : KEnv lzero} →
(κ : Kind lzero) →
Ty Δ ★₁
map-ΣT κ =
`∀ R[ κ ] (`∀ (κ `→ ★₀) (`∀ (κ `→ ★₀)
(Iter κ f g z `→ (Σ (⌈ f ⌉· z)) `→ Σ (⌈ g ⌉· z) )))
where
g = tvar Z
f = tvar (S Z)
z = tvar (S (S Z))
map-Σ : ∀ {Δ : KEnv lzero} {Φ : PEnv Δ lzero} {Γ : Env Δ lzero} →
(κ : Kind lzero) →
Tm Δ Φ Γ (map-ΣT κ)
map-Σ κ =
`Λ R[ κ ]
(`Λ (κ `→ ★₀)
(`Λ (κ `→ ★₀)
(`λ (Iter κ (tvar (S Z)) (tvar Z) (tvar (S (S Z))))
(`λ (Σ (⌈ f ⌉· tvar (S (S Z))))
((ana (tvar (S (S Z))) (tvar (S Z)) (Σ (⌈ tvar Z ⌉· (tvar (S (S Z)))))
(`Λ L
(`Λ κ
(`Λ R[ κ ]
(`ƛ ((tvar (S (S Z)) R▹ tvar (S Z)) · (tvar Z) ~ tvar (S (S (S (S (S Z))))))
(`λ ⌊ tvar (S (S Z)) ⌋
(`λ (tvar (S (S (S (S Z)))) ·[ (tvar (S Z)) ])
(((con' · l) · ((i' · l) · x)
))))))))) · (var Z))))))
where
f = tvar (S Z)
x = var Z
l = var (S Z)
i' =
let
Ł = tvar (S (S Z))
U = tvar (S Z)
Y = tvar Z
in ((((var (S (S (S Z)))) ·[ Ł ]) ·[ U ]) ·[ Y ]) ·⟨ n-var Z ⟩
con' =
let
Ł = tvar (S (S Z))
U = tvar (S Z)
z' = tvar (S (S (S (S (S Z)))))
g' = tvar (S (S (S Z)))
in (((con
·[ Ł ])
·[ g' ·[ U ] ])
·[ ⌈ g' ⌉· z' ])
·⟨ evidence ⟩
where
evidence : let
Ł = tvar (S (S Z))
U = tvar (S Z)
z' = tvar (S (S (S (S (S Z)))))
g' = tvar (S (S (S Z)))
in Ent _ _ ((Ł R▹ (g' ·[ U ]) ) ≲ (⌈ g' ⌉· z'))
evidence = let
Ł = tvar (S (S Z))
U = tvar (S Z)
Y = tvar Z
z' = tvar (S (S (S (S (S Z)))))
g' = tvar (S (S (S Z)))
in
((((Ł R▹ U) · Y ~ z')
⊩⟨ n-·≲L ⟩
((Ł R▹ U) ≲ z'
⊩⟨ n-≲lift₂ ⟩
⌈ g' ⌉· (Ł R▹ U ) ≲ ⌈ g' ⌉· z'
⊩⟨ n-≡ (peq-≲ teq-lift₂ teq-refl) ⟩
∎)) (n-var Z))