module A201607.BasicIPC.Metatheory.GentzenNormalForm-KripkeMcKinseyTarski where
open import A201607.BasicIPC.Syntax.GentzenNormalForm public
open import A201607.BasicIPC.Semantics.KripkeMcKinseyTarski public
eval : ∀ {A Γ} → Γ ⊢ A → Γ ⊨ A
eval (var i) γ = lookup i γ
eval (lam t) γ = λ ξ a → eval t (mono⊩⋆ ξ γ , a)
eval (app t u) γ = (eval t γ refl≤) (eval u γ)
eval (pair t u) γ = eval t γ , eval u γ
eval (fst t) γ = π₁ (eval t γ)
eval (snd t) γ = π₂ (eval t γ)
eval unit γ = ∙
eval⋆ : ∀ {Ξ Γ} → Γ ⊢⋆ Ξ → Γ ⊨⋆ Ξ
eval⋆ {∅} ∙ γ = ∙
eval⋆ {Ξ , A} (ts , t) γ = eval⋆ ts γ , eval t γ
private
instance
canon : Model
canon = record
{ World = Cx Ty
; _≤_ = _⊆_
; refl≤ = refl⊆
; trans≤ = trans⊆
; _⊩ᵅ_ = λ Γ P → Γ ⊢ⁿᵉ α P
; mono⊩ᵅ = mono⊢ⁿᵉ
}
mutual
reflectᶜ : ∀ {A Γ} → Γ ⊢ⁿᵉ A → Γ ⊩ A
reflectᶜ {α P} t = t
reflectᶜ {A ▻ B} t = λ η a → reflectᶜ (appⁿᵉ (mono⊢ⁿᵉ η t) (reifyᶜ a))
reflectᶜ {A ∧ B} t = reflectᶜ (fstⁿᵉ t) , reflectᶜ (sndⁿᵉ t)
reflectᶜ {⊤} t = ∙
reifyᶜ : ∀ {A Γ} → Γ ⊩ A → Γ ⊢ⁿᶠ A
reifyᶜ {α P} s = neⁿᶠ s
reifyᶜ {A ▻ B} s = lamⁿᶠ (reifyᶜ (s weak⊆ (reflectᶜ {A} (varⁿᵉ top))))
reifyᶜ {A ∧ B} s = pairⁿᶠ (reifyᶜ (π₁ s)) (reifyᶜ (π₂ s))
reifyᶜ {⊤} s = unitⁿᶠ
reflectᶜ⋆ : ∀ {Ξ Γ} → Γ ⊢⋆ⁿᵉ Ξ → Γ ⊩⋆ Ξ
reflectᶜ⋆ {∅} ∙ = ∙
reflectᶜ⋆ {Ξ , A} (ts , t) = reflectᶜ⋆ ts , reflectᶜ t
reifyᶜ⋆ : ∀ {Ξ Γ} → Γ ⊩⋆ Ξ → Γ ⊢⋆ⁿᶠ Ξ
reifyᶜ⋆ {∅} ∙ = ∙
reifyᶜ⋆ {Ξ , A} (ts , t) = reifyᶜ⋆ ts , reifyᶜ t
refl⊩⋆ : ∀ {Γ} → Γ ⊩⋆ Γ
refl⊩⋆ = reflectᶜ⋆ refl⊢⋆ⁿᵉ
trans⊩⋆ : ∀ {Γ Γ′ Γ″} → Γ ⊩⋆ Γ′ → Γ′ ⊩⋆ Γ″ → Γ ⊩⋆ Γ″
trans⊩⋆ ts us = eval⋆ (trans⊢⋆ (nf→tm⋆ (reifyᶜ⋆ ts)) (nf→tm⋆ (reifyᶜ⋆ us))) refl⊩⋆
quot : ∀ {A Γ} → Γ ⊨ A → Γ ⊢ A
quot s = nf→tm (reifyᶜ (s refl⊩⋆))
norm : ∀ {A Γ} → Γ ⊢ A → Γ ⊢ A
norm = quot ∘ eval