{-# OPTIONS --cumulativity #-}
module ROmega.Types.Substitution.Properties where
open import Agda.Primitive
open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym; trans; cong; cong-app)
open import Data.Product
renaming (proj₁ to fst; proj₂ to snd)
open import ROmega.Types
open import ROmega.Types.Substitution
open import ROmega.Postulates.FunExt
Δ-map-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂)
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : Δ-map Δ₁ Δ₂) → Setω
Δ-map-preservation {ℓ₁} {ℓ₂} Δ₁ Δ₂ H₁ H₂ f =
∀ {ℓ₃} {κ : Kind ℓ₃} →
(x : TVar Δ₁ κ) → _≡_ {a = lsuc ℓ₃} (⟦ x ⟧tv H₁) (⟦ f x ⟧tv H₂)
τ-map-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂) →
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : τ-map Δ₁ Δ₂) → Setω
τ-map-preservation {ℓ₁} Δ₁ Δ₂ H₁ H₂ f =
∀ {ℓ₃} {κ : Kind ℓ₃} →
(τ : Ty Δ₁ κ) → _≡_ {a = lsuc ℓ₃} (⟦ τ ⟧t H₁) (⟦ f τ ⟧t H₂)
π-map-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂) →
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : π-map Δ₁ Δ₂) → Setω
π-map-preservation {ℓ₁} Δ₁ Δ₂ H₁ H₂ f =
∀ {ℓ₃}{κ : Kind ℓ₃}
(π : Pred Δ₁ κ) → _≡_ {a = (lsuc (lsuc ℓ₃))} (⟦ π ⟧p H₁) (⟦ f π ⟧p H₂)
Context-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂)
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : Context Δ₁ Δ₂) → Setω
Context-preservation {ℓ₁} {ℓ₂} Δ₁ Δ₂ H₁ H₂ f =
∀ {ℓ₃} {κ : Kind ℓ₃} →
(x : TVar Δ₁ κ) → _≡_ {a = lsuc ℓ₃} (⟦ x ⟧tv H₁) (⟦ f x ⟧t H₂)
id : ∀ {ℓ}{X : Set ℓ} → X → X
id x = x
id-pres : ∀ {ℓ₁} (Δ₁ : KEnv ℓ₁) (H : ⟦ Δ₁ ⟧ke) →
Δ-map-preservation Δ₁ Δ₁ H H id
id-pres Δ₁ H x = refl
ext-pres : ∀ {ℓ₁ ℓ₂ ℓ₃}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂)
(H₁ : ⟦ Δ₁ ⟧ke) (H₂ : ⟦ Δ₂ ⟧ke)
{κ : Kind ℓ₃} →
(f : Δ-map Δ₁ Δ₂) →
(Δ-pres : Δ-map-preservation Δ₁ Δ₂ H₁ H₂ f) →
∀ (X : ⟦ κ ⟧k) → Δ-map-preservation (Δ₁ , κ) (Δ₂ , κ) (H₁ , X) (H₂ , X) (ext f)
ext-pres Δ₁ Δ₂ H₁ H₂ f Δ-pres X Z = refl
ext-pres Δ₁ Δ₂ H₁ H₂ f Δ-pres X (S v) = Δ-pres v
τ-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂) →
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : Δ-map Δ₁ Δ₂) →
(Δ-pres : Δ-map-preservation Δ₁ Δ₂ H₁ H₂ f) →
τ-map-preservation Δ₁ Δ₂ H₁ H₂ (rename f)
π-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂) →
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : Δ-map Δ₁ Δ₂) →
(Δ-pres : Δ-map-preservation Δ₁ Δ₂ H₁ H₂ f) →
π-map-preservation Δ₁ Δ₂ H₁ H₂ (renamePred f)
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (tvar x') = Δ-pres x'
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (`∀ κ τ) =
∀-extensionality
extensionality
(λ z → ⟦ τ ⟧t (H₁ , z))
(λ z → ⟦ rename (ext f) τ ⟧t (H₂ , z))
τ-pres
where
τ-pres : (x : ⟦ κ ⟧k) → ⟦ τ ⟧t (H₁ , x) ≡ ⟦ rename (ext f) τ ⟧t (H₂ , x)
τ-pres x = τ-preservation
(Δ₁ , κ) (Δ₂ , κ)
(H₁ , x) (H₂ , x)
(ext f)
(ext-pres Δ₁ Δ₂ H₁ H₂ f Δ-pres x)
τ
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (`λ κ τ) = extensionality τ-pres
where
τ-pres : (x : ⟦ κ ⟧k) → ⟦ τ ⟧t (H₁ , x) ≡ ⟦ rename (ext f) τ ⟧t (H₂ , x)
τ-pres x = τ-preservation
(Δ₁ , κ) (Δ₂ , κ)
(H₁ , x) (H₂ , x)
(ext f)
(ext-pres Δ₁ Δ₂ H₁ H₂ f Δ-pres x)
τ
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres U = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (lab x) = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (τ₁ `→ τ₂)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ₁
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ₂ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (τ ·[ υ ])
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres υ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (τ ▹ υ)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres υ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (τ R▹ υ)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres υ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ⌊ τ ⌋
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (Π τ)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (Ty.Σ τ)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (⌈ τ ⌉· ρ)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ρ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (ρ ·⌈ τ ⌉)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ |
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ρ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (π ⇒ τ)
rewrite π-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres π
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres τ = refl
τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ∅ = refl
π-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (ρ₁ ≲ ρ₂)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ρ₁
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ρ₂ = refl
π-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres (ρ₁ · ρ₂ ~ ρ₃)
rewrite τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ρ₁
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ρ₂
| τ-preservation Δ₁ Δ₂ H₁ H₂ f Δ-pres ρ₃ = refl
exts-pres : ∀ {ℓ₁ ℓ₂ ℓ₃}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂)
(H₁ : ⟦ Δ₁ ⟧ke) (H₂ : ⟦ Δ₂ ⟧ke)
{κ : Kind ℓ₃} →
(f : Context Δ₁ Δ₂) →
(Δ-pres : Context-preservation Δ₁ Δ₂ H₁ H₂ f) →
∀ (X : ⟦ κ ⟧k) → Context-preservation (Δ₁ , κ) (Δ₂ , κ) (H₁ , X) (H₂ , X) (exts f)
exts-pres Δ₁ Δ₂ H₁ H₂ f σ-pres X Z = refl
exts-pres Δ₁ Δ₂ H₁ H₂ {κ} f σ-pres X (S c)
rewrite sym (τ-preservation Δ₂ (Δ₂ , κ) H₂ (H₂ , X) S (λ _ → refl) (f c))
| sym (σ-pres c) = refl
σ/τ-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂) →
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : Context Δ₁ Δ₂) →
(σ-pres : Context-preservation Δ₁ Δ₂ H₁ H₂ f) →
τ-map-preservation Δ₁ Δ₂ H₁ H₂ (subst f)
σ/π-preservation : ∀ {ℓ₁ ℓ₂}
(Δ₁ : KEnv ℓ₁) (Δ₂ : KEnv ℓ₂) →
(H₁ : ⟦ Δ₁ ⟧ke)(H₂ : ⟦ Δ₂ ⟧ke) →
(f : Context Δ₁ Δ₂) →
(σ-pres : Context-preservation Δ₁ Δ₂ H₁ H₂ f) →
π-map-preservation Δ₁ Δ₂ H₁ H₂ (substPred f)
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (tvar x) = σ-pres x
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (`∀ κ τ) =
∀-extensionality
extensionality
(λ z → ⟦ τ ⟧t (H₁ , z))
(λ z → ⟦ subst (exts f) τ ⟧t (H₂ , z))
τ-pres
where
τ-pres : (x : ⟦ κ ⟧k) → ⟦ τ ⟧t (H₁ , x) ≡ ⟦ subst (exts f) τ ⟧t (H₂ , x)
τ-pres x = σ/τ-preservation
(Δ₁ , κ) (Δ₂ , κ)
(H₁ , x) (H₂ , x)
(exts f)
(exts-pres Δ₁ Δ₂ H₁ H₂ f σ-pres x)
τ
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (`λ κ τ) = extensionality τ-pres
where
τ-pres : (x : ⟦ κ ⟧k) → ⟦ τ ⟧t (H₁ , x) ≡ ⟦ subst (exts f) τ ⟧t (H₂ , x)
τ-pres x = σ/τ-preservation
(Δ₁ , κ) (Δ₂ , κ)
(H₁ , x) (H₂ , x)
(exts f)
(exts-pres Δ₁ Δ₂ H₁ H₂ f σ-pres x)
τ
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (π ⇒ τ)
rewrite σ/π-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres π
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres U = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (lab x) = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (τ₁ `→ τ₂)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ₁
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ₂ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (τ ·[ υ ])
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres υ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (τ ▹ υ)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres υ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (τ R▹ υ)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres υ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres ⌊ τ ⌋
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (Π τ)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (Ty.Σ τ)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (⌈ τ ⌉· ρ)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres ρ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres ( ρ ·⌈ τ ⌉)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ |
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres ρ = refl
σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres ∅ = refl
σ/π-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (τ₁ ≲ τ₂)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ₁
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ₂ = refl
σ/π-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres (τ₁ · τ₂ ~ τ₃)
rewrite σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ₁
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ₂
| σ/τ-preservation Δ₁ Δ₂ H₁ H₂ f σ-pres τ₃ = refl
Substitution : ∀ {ℓΔ ℓκ ℓκ'} {Δ : KEnv ℓΔ} {κ : Kind ℓκ} {κ' : Kind ℓκ'}
(τ : Ty (Δ , κ') κ) (υ : Ty Δ κ') H →
⟦ τ ⟧t (H , ⟦ υ ⟧t H) ≡ ⟦ subst (Z↦ υ) τ ⟧t H
Substitution {ℓΔ} {ℓκ} {ℓκ'} {Δ = Δ} {κ' = κ'} τ υ H = σ/τ-preservation
(Δ , κ') Δ ((H , ⟦ υ ⟧t H)) H (Z↦ υ) ctx-pres τ
where
ctx-pres : Context-preservation (Δ , κ') Δ (H , ⟦ υ ⟧t H) H (Z↦ υ)
ctx-pres Z = refl
ctx-pres (S x) = refl
Weakening : ∀ {ℓΔ ℓκ ℓκ'} {Δ : KEnv ℓΔ} {κ : Kind ℓκ} {κ' : Kind ℓκ'} →
(τ : Ty Δ κ) (H : ⟦ Δ ⟧ke) (X : ⟦ κ' ⟧k) →
⟦ τ ⟧t H ≡ ⟦ weaken τ ⟧t (H , X)
Weakening {Δ = Δ} {κ' = κ'} τ H X =
τ-preservation Δ (Δ , κ') H (H , X) S (λ _ → refl) τ
Weakening₂ : ∀ {ℓΔ ℓκ ℓκA ℓκB} {Δ : KEnv ℓΔ}
{κ : Kind ℓκ} {κA : Kind ℓκA} {κB : Kind ℓκB} →
(τ : Ty Δ κ) (H : ⟦ Δ ⟧ke) (A : ⟦ κA ⟧k) (B : ⟦ κB ⟧k) →
⟦ τ ⟧t H ≡ ⟦ weaken (weaken τ) ⟧t ((H , A) , B)
Weakening₂ τ H A B = trans (Weakening τ H A) (Weakening (weaken τ) (H , A) B)
Weakening₃ : ∀ {ℓΔ ℓκ ℓκA ℓκB ℓκC} {Δ : KEnv ℓΔ}
{κ : Kind ℓκ} {κA : Kind ℓκA} {κB : Kind ℓκB} {κC : Kind ℓκC} →
(τ : Ty Δ κ) (H : ⟦ Δ ⟧ke) (A : ⟦ κA ⟧k) (B : ⟦ κB ⟧k) (C : ⟦ κC ⟧k) →
⟦ τ ⟧t H ≡ ⟦ weaken (weaken (weaken τ)) ⟧t (((H , A) , B) , C)
Weakening₃ τ H A B C = trans (Weakening₂ τ H A B) (Weakening (weaken (weaken τ)) ((H , A) , B) C)