module A201607.BasicIS4.Metatheory.Hilbert-TarskiGluedImplicit where

open import A201607.BasicIS4.Syntax.Hilbert public
open import A201607.BasicIS4.Semantics.TarskiGluedImplicit public

open ImplicitSyntax (_⊢_) public


-- Additional useful equipment.

module _ {{_ : Model}} where
  _⟪D⟫_ :  {A B Γ}  Γ   (A  B)  Γ   A  Γ   B
  _⟪D⟫_ {A} {B} s₁ s₂ η = let t  s₁′ = s₁ η
                              u  a   = s₂ η
                          in  app (app cdist t) u  _⟪$⟫_ {A} {B} s₁′ a

  _⟪D⟫′_ :  {A B Γ}  Γ   (A  B)  Γ   A   B
  _⟪D⟫′_ {A} {B} s₁ η = _⟪D⟫_ (mono⊩ { (A  B)} η s₁)

  ⟪↑⟫ :  {A Γ}  Γ   A  Γ    A
  ⟪↑⟫ s η = app cup (syn (s η))  λ η′  s (trans⊆ η η′)


-- Soundness with respect to all models, or evaluation.

eval :  {A Γ}  Γ  A  Γ  A
eval (var i)           γ = lookup i γ
eval (app {A} {B} t u) γ = _⟪$⟫_ {A} {B} (eval t γ) (eval u γ)
eval ci                γ = K I
eval (ck {A} {B})      γ = K (⟪K⟫ {A} {B})
eval (cs {A} {B} {C})  γ = K (⟪S⟫′ {A} {B} {C})
eval (box t)           γ = K (box t  eval t )
eval cdist             γ = K _⟪D⟫′_
eval cup               γ = K ⟪↑⟫
eval cdown             γ = K ⟪↓⟫
eval (cpair {A} {B})   γ = K (_⟪,⟫′_ {A} {B})
eval cfst              γ = K π₁
eval csnd              γ = K π₂
eval unit              γ = 


-- TODO: Correctness of evaluation with respect to conversion.


-- The canonical model.

private
  instance
    canon : Model
    canon = record
      { _⊩ᵅ_   = λ Γ P  Γ  α P
      ; mono⊩ᵅ = mono⊢
      }


-- Soundness and completeness with respect to the canonical model.

mutual
  reflectᶜ :  {A Γ}  Γ  A  Γ  A
  reflectᶜ {α P}   t = t
  reflectᶜ {A  B} t = λ η  let t′ = mono⊢ η t
                              in  λ a  reflectᶜ (app t′ (reifyᶜ a))
  reflectᶜ { A}   t = λ η  let t′ = mono⊢ η t
                              in  t′  reflectᶜ (down t′)
  reflectᶜ {A  B} t = reflectᶜ (fst t) , reflectᶜ (snd t)
  reflectᶜ {}    t = 

  reifyᶜ :  {A Γ}  Γ  A  Γ  A
  reifyᶜ {α P}   s = s
  reifyᶜ {A  B} s = lam (reifyᶜ (s weak⊆ (reflectᶜ {A} v₀)))
  reifyᶜ { A}   s = syn (s refl⊆)
  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


-- Reflexivity and transitivity.

refl⊩⋆ :  {Γ}  Γ ⊩⋆ Γ
refl⊩⋆ = reflectᶜ⋆ refl⊢⋆

trans⊩⋆ :  {Γ Γ′ Γ″}  Γ ⊩⋆ Γ′  Γ′ ⊩⋆ Γ″  Γ ⊩⋆ Γ″
trans⊩⋆ ts us = reflectᶜ⋆ (trans⊢⋆ (reifyᶜ⋆ ts) (reifyᶜ⋆ us))


-- Completeness with respect to all models, or quotation.

quot :  {A Γ}  Γ  A  Γ  A
quot s = reifyᶜ (s refl⊩⋆)


-- Normalisation by evaluation.

norm :  {A Γ}  Γ  A  Γ  A
norm = quot  eval


-- TODO: Correctness of normalisation with respect to conversion.