module A201607.BasicIPC.Metatheory.Gentzen-KripkeConcreteGluedImplicit where
open import A201607.BasicIPC.Syntax.Gentzen public
open import A201607.BasicIPC.Semantics.KripkeConcreteGluedImplicit public
open ImplicitSyntax (_⊢_) (mono⊢) public
module _ {{_ : Model}} where
reify : ∀ {A w} → w ⊩ A → unwrap w ⊢ A
reify {α P} s = syn s
reify {A ▻ B} s = syn s
reify {A ∧ B} s = pair (reify (π₁ s)) (reify (π₂ s))
reify {⊤} s = unit
reify⋆ : ∀ {Ξ w} → w ⊩⋆ Ξ → unwrap w ⊢⋆ Ξ
reify⋆ {∅} ∙ = ∙
reify⋆ {Ξ , A} (ts , t) = reify⋆ ts , reify t
eval : ∀ {A Γ} → Γ ⊢ A → Γ ⊨ A
eval (var i) γ = lookup i γ
eval (lam t) γ = multicut (reify⋆ γ) (lam t) ⅋ λ ξ a →
eval t (mono⊩⋆ ξ γ , a)
eval (app t u) γ = eval t γ ⟪$⟫ eval u γ
eval (pair t u) γ = eval t γ , eval u γ
eval (fst t) γ = π₁ (eval t γ)
eval (snd t) γ = π₂ (eval t γ)
eval unit γ = ∙
private
instance
canon : Model
canon = record
{ _⊩ᵅ_ = λ w P → unwrap w ⊢ α P
; mono⊩ᵅ = λ ξ t → mono⊢ (unwrap≤ ξ) t
}
reflectᶜ : ∀ {A w} → unwrap w ⊢ A → w ⊩ A
reflectᶜ {α P} t = t ⅋ t
reflectᶜ {A ▻ B} t = t ⅋ λ ξ a → reflectᶜ (app (mono⊢ (unwrap≤ ξ) t) (reify a))
reflectᶜ {A ∧ B} t = reflectᶜ (fst t) , reflectᶜ (snd t)
reflectᶜ {⊤} t = ∙
reflectᶜ⋆ : ∀ {Ξ w} → unwrap w ⊢⋆ Ξ → w ⊩⋆ Ξ
reflectᶜ⋆ {∅} ∙ = ∙
reflectᶜ⋆ {Ξ , A} (ts , t) = reflectᶜ⋆ ts , reflectᶜ t
refl⊩⋆ : ∀ {w} → w ⊩⋆ unwrap w
refl⊩⋆ = reflectᶜ⋆ refl⊢⋆
trans⊩⋆ : ∀ {w w′ w″} → w ⊩⋆ unwrap w′ → w′ ⊩⋆ unwrap w″ → w ⊩⋆ unwrap w″
trans⊩⋆ ts us = reflectᶜ⋆ (trans⊢⋆ (reify⋆ ts) (reify⋆ us))
quot : ∀ {A Γ} → Γ ⊨ A → Γ ⊢ A
quot s = reify (s refl⊩⋆)
norm : ∀ {A Γ} → Γ ⊢ A → Γ ⊢ A
norm = quot ∘ eval