module A201607.BasicIPC.Metatheory.Hilbert-TarskiConcreteGluedHilbert where
open import A201607.BasicIPC.Syntax.Hilbert public
open import A201607.BasicIPC.Semantics.TarskiConcreteGluedHilbert public
module _ {{_ : Model}} where
[_] : ∀ {A Γ} → Γ ⊢ A → Γ [⊢] A
[ var i ] = [var] i
[ app t u ] = [app] [ t ] [ u ]
[ ci ] = [ci]
[ ck ] = [ck]
[ cs ] = [cs]
[ cpair ] = [cpair]
[ cfst ] = [cfst]
[ csnd ] = [csnd]
[ unit ] = [unit]
eval : ∀ {A Γ} → Γ ⊢ A → Γ ⊨ A
eval (var i) γ = lookup i γ
eval (app t u) γ = eval t γ ⟪$⟫ eval u γ
eval ci γ = [ci] ⅋ I
eval ck γ = [ck] ⅋ ⟪K⟫
eval cs γ = [cs] ⅋ ⟪S⟫′
eval cpair γ = [cpair] ⅋ _⟪,⟫′_
eval cfst γ = [cfst] ⅋ π₁
eval csnd γ = [csnd] ⅋ π₂
eval unit γ = ∙
private
instance
canon : Model
canon = record
{ _⊩ᵅ_ = λ w P → unwrap w ⊢ α P
; _[⊢]_ = _⊢_
; mono[⊢] = mono⊢
; [var] = var
; [app] = app
; [ci] = ci
; [ck] = ck
; [cs] = cs
; [cpair] = cpair
; [cfst] = cfst
; [csnd] = csnd
; [unit] = unit
; [lam] = lam
}
mutual
reflectᶜ : ∀ {A w} → unwrap w ⊢ A → w ⊩ A
reflectᶜ {α P} t = t ⅋ t
reflectᶜ {A ▻ B} t = t ⅋ λ a → reflectᶜ (app t (reifyᶜ a))
reflectᶜ {A ∧ B} t = reflectᶜ (fst t) , reflectᶜ (snd t)
reflectᶜ {⊤} t = ∙
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
reflectᶜ⋆ : ∀ {Ξ w} → unwrap w ⊢⋆ Ξ → w ⊩⋆ Ξ
reflectᶜ⋆ {∅} ∙ = ∙
reflectᶜ⋆ {Ξ , A} (ts , t) = reflectᶜ⋆ ts , reflectᶜ t
reifyᶜ⋆ : ∀ {Ξ w} → w ⊩⋆ Ξ → unwrap w ⊢⋆ Ξ
reifyᶜ⋆ {∅} ∙ = ∙
reifyᶜ⋆ {Ξ , A} (ts , t) = reifyᶜ⋆ ts , reifyᶜ 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