{-# OPTIONS --without-K --safe #-}

module STLCSubst.Statics.Rules where

open import Lib
open import STLCSubst.Statics.Definitions

open import Relation.Binary.PropositionalEquality hiding ([_])


infix 4 _⊢_∶_

data _⊢_∶_ : Ctx → Exp → Typ → Set where
  vlookup : ∀ {x} →
            x ∶ T ∈ Γ →
            ------------
            Γ ⊢ v x ∶ T
  ze-I    : Γ ⊢ ze ∶ N
  su-I    : Γ ⊢ t ∶ N →
            -------------
            Γ ⊢ su t ∶ N
  N-E     : Γ ⊢ s ∶ T →
            T ∷ N ∷ Γ ⊢ r ∶ T →
            Γ ⊢ t ∶ N →
            ----------------------
            Γ ⊢ rec T s r t ∶ T
  Λ-I     : S ∷ Γ ⊢ t ∶ T →
            ------------------
            Γ ⊢ Λ t ∶ S ⟶ T
  Λ-E     : Γ ⊢ r ∶ S ⟶ T →
            Γ ⊢ s ∶ S →
            ------------------
            Γ ⊢ r $ s ∶ T

infix 4 _⊢w_∶_ _⊢s_∶_

_⊢w_∶_ : Ctx → Wk → Ctx → Set
Γ ⊢w ϕ ∶ Δ = ∀ {x T} → x ∶ T ∈ Δ → ϕ x ∶ T ∈ Γ

_⊢s_∶_ : Ctx → Subst → Ctx → Set
Γ ⊢s σ ∶ Δ = ∀ {x T} → x ∶ T ∈ Δ → Γ ⊢ σ x ∶ T

infix 4 _⊢_≈_∶_

data _⊢_≈_∶_ : Ctx → Exp → Exp → Typ → Set where
  v-≈      : ∀ {x} →
             x ∶ T ∈ Γ →
             -----------------------------------
             Γ ⊢ v x              ≈ v x ∶ T
  ze-≈     : Γ ⊢ ze               ≈ ze ∶ N
  su-cong  : Γ ⊢ t                ≈ t′ ∶ N →
             ------------------------------------
             Γ ⊢ su t             ≈ su t′ ∶ N
  rec-cong : Γ ⊢ s                ≈ s′ ∶ T →
             T ∷ N ∷ Γ ⊢ r        ≈ r′ ∶ T →
             Γ ⊢ t                ≈ t′ ∶ N →
             -----------------------------------------
             Γ ⊢ rec T s r t      ≈ rec T s′ r′ t′ ∶ T
  Λ-cong   : S ∷ Γ ⊢ t            ≈ t′ ∶ T →
             -------------------------------------
             Γ ⊢ Λ t              ≈ Λ t′ ∶ S ⟶ T
  $-cong   : Γ ⊢ r                ≈ r′ ∶ S ⟶ T →
             Γ ⊢ s                ≈ s′ ∶ S →
             -------------------------------------
             Γ ⊢ r $ s            ≈ r′ $ s′ ∶ T
  rec-β-ze : Γ ⊢ s ∶ T →
             T ∷ N ∷ Γ ⊢ r ∶ T →
             -----------------------------
             Γ ⊢ rec T s r ze     ≈ s ∶ T
  rec-β-su : Γ ⊢ s ∶ T →
             T ∷ N ∷ Γ ⊢ r ∶ T →
             Γ ⊢ t ∶ N →
             --------------------------------------------------
             Γ ⊢ rec T s r (su t) ≈ r [ id ↦ t ↦ rec T s r t ] ∶ T
  Λ-β      : S ∷ Γ ⊢ t ∶ T →
             Γ ⊢ s ∶ S →
             --------------------------------------
             Γ ⊢ Λ t $ s          ≈ t [ id ↦ s ] ∶ T
  Λ-η      : Γ ⊢ t ∶ S ⟶ T →
             ------------------------------------------------
             Γ ⊢ t                ≈ Λ ((t [ ⇑ ]) $ v 0) ∶ S ⟶ T
  ≈-sym    : Γ ⊢ t                ≈ t′ ∶ T →
             -------------------------------
             Γ ⊢ t′               ≈ t ∶ T
  ≈-trans  : Γ ⊢ t                ≈ t′ ∶ T →
             Γ ⊢ t′               ≈ t″ ∶ T →
             --------------------------------
             Γ ⊢ t                ≈ t″ ∶ T


infix 4 _⊢s_≈_∶_

_⊢s_≈_∶_ : Ctx → Subst → Subst → Ctx → Set
Γ ⊢s σ ≈ σ′ ∶ Δ = ∀ {x T} → x ∶ T ∈ Δ → Γ ⊢ σ x ≈ σ′ x ∶ T

≈-refl : Γ ⊢ t ∶ T → Γ ⊢ t ≈ t ∶ T
≈-refl (vlookup T∈Γ) = v-≈ T∈Γ
≈-refl ze-I          = ze-≈
≈-refl (su-I t)      = su-cong (≈-refl t)
≈-refl (N-E s r t)   = rec-cong (≈-refl s) (≈-refl r) (≈-refl t)
≈-refl (Λ-I t)       = Λ-cong (≈-refl t)
≈-refl (Λ-E r s)     = $-cong (≈-refl r) (≈-refl s)

⊢subst-refl : Γ ⊢s σ ∶ Δ → Γ ⊢s σ ≈ σ ∶ Δ
⊢subst-refl ⊢σ T∈Δ = ≈-refl (⊢σ T∈Δ)

⊢w-transp : Γ ⊢w ϕ ∶ Δ → ϕ ≗ ϕ′ → Γ ⊢w ϕ′ ∶ Δ
⊢w-transp ⊢ϕ eq {x} T∈Δ
  with ⊢ϕ T∈Δ
...  | pf rewrite eq x = pf

⊢s-transp : Γ ⊢s σ ∶ Δ → σ ≗ σ′ → Γ ⊢s σ′ ∶ Δ
⊢s-transp ⊢σ eq {x} T∈Δ
  with ⊢σ T∈Δ
...  | pf rewrite eq x = pf