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

module Unbox.Statics where

open import Lib

open import Level renaming (suc to succ)
open import LibNonEmpty public
open import Unbox.Typ public


record HasO {i} (A : Set i) : Set i where
  field
    O : A    

open HasO {{...}} public

record HasTr {i} (A : Set i) : Set i where
  field
    Tr : A    A

open HasTr {{...}} public

record Monotone {i j} (A : Set i) (B : Set j) : Set (i  j) where
  infixl 8 _[_]
  field
    _[_] : A  B  A

open Monotone {{...}} public


infixl 10 _$_
infixl 3 _∘_
infixl 5 _;_
mutual
  data Exp : Set where
    v     : (x : )  Exp
    Λ     : Exp  Exp
    _$_   : Exp  Exp  Exp
    box   : Exp  Exp
    unbox :   Exp  Exp
    sub   : Exp  Substs  Exp

  data Substs : Set where
    I    : Substs
    p    : Substs
    _,_  : Substs  Exp  Substs
    _;_ : Substs    Substs
    _∘_  : Substs  Substs  Substs

instance
  ExpMonotone : Monotone Exp Substs
  ExpMonotone = record { _[_] = sub }

q : Substs  Substs
q σ = (σ  p) , v 0

S-O : Substs    
S-O σ 0              = 0
S-O I (suc n)        = suc n
S-O p (suc n)        = suc n
S-O (σ , t) (suc n)  = S-O σ (suc n)
S-O (σ  m) (suc n) = m + S-O σ n
S-O (σ  δ) (suc n)  = S-O δ (S-O σ (suc n))

instance
  SubstsHasO : HasO Substs
  SubstsHasO = record { O = S-O }

S-Tr : Substs    Substs
S-Tr σ 0              = σ
S-Tr I (suc n)        = I
S-Tr p (suc n)        = I
S-Tr (σ , t) (suc n)  = S-Tr σ (suc n)
S-Tr (σ  m) (suc n) = S-Tr σ n
S-Tr (σ  δ) (suc n)  = S-Tr σ (suc n)  S-Tr δ (O σ (suc n))

instance
  SubstsHasTr : HasTr Substs
  SubstsHasTr = record { Tr = S-Tr }

variable
  t t′ t″ : Exp
  r r′ r″ : Exp
  s s′ s″ : Exp
  σ σ′ σ″ : Substs
  δ δ′ δ″ : Substs

infix 4 _⊢_∶_ _⊢s_∶_
mutual
  data _⊢_∶_ : Ctxs  Exp  Typ  Set where
    vlookup :  {x} 
              x  T  Γ 
              ----------------
              Γ  Γs  v x  T
    ⟶-I     : (S  Γ)  Γs  t  T 
              ----------------------
              Γ  Γs  Λ t  S  T
    ⟶-E     : Ψ  t  S  T 
              Ψ  s  S 
              -------------
              Ψ  t $ s  T
    □-I     : [] ∷⁺ Ψ  t  T 
              -----------------
              Ψ  box t   T
    □-E     :  {n} Γs 
              Ψ  t   T 
              len Γs  n 
              -------------------------
              Γs ++⁺ Ψ  unbox n t  T
    t[σ]    : Ψ  t  T 
              Ψ′ ⊢s σ  Ψ 
              ----------------
              Ψ′  t [ σ ]  T

  data _⊢s_∶_ : Ctxs  Substs  Ctxs  Set where
    S-I  : Ψ ⊢s I  Ψ
    S-p  : (T  Γ)  Γs ⊢s p  Γ  Γs
    S-,  : Ψ ⊢s σ  Γ  Γs 
           Ψ  t  T 
           --------------------------
           Ψ ⊢s σ , t  (T  Γ)  Γs
    S-; :  {n} Γs 
           Ψ ⊢s σ  Ψ′ 
           len Γs  n 
           -------------------------------
           Γs ++⁺ Ψ ⊢s σ  n  [] ∷⁺ Ψ′
    S-∘  : Ψ ⊢s δ  Ψ′ 
           Ψ′ ⊢s σ  Ψ″ 
           -----------------
           Ψ ⊢s σ  δ  Ψ″

⊢q : Γ  Γs ⊢s σ  Δ  Δs   T  (T  Γ)  Γs ⊢s q σ  (T  Δ)  Δs
⊢q ⊢σ T = S-, (S-∘ S-p ⊢σ) (vlookup here)

infix 4 _⊢_≈_∶_ _⊢s_≈_∶_

mutual
  data _⊢_≈_∶_ : Ctxs  Exp  Exp  Typ  Set where
    v-≈        :  {x} 
                 x  T  Γ 
                 ----------------------
                 Γ  Γs  v x  v x  T
    Λ-cong     : (S  Γ)  Γs  t  t′  T 
                 ---------------------------
                 Γ  Γs  Λ t  Λ t′  S  T
    $-cong     : Ψ  t  t′  S  T 
                 Ψ  s  s′  S 
                 -----------------------
                 Ψ  t $ s  t′ $ s′  T
    box-cong   : [] ∷⁺ Ψ  t  t′  T 
                 ------------------------
                 Ψ  box t  box t′   T
    unbox-cong :  {n} Γs 
                 Ψ  t  t′   T 
                 len Γs  n 
                 --------------------------------------
                 Γs ++⁺ Ψ  unbox n t  unbox n t′  T
    []-cong    : Ψ  t  t′  T 
                 Ψ′ ⊢s σ  σ′  Ψ 
                 ------------------------------
                 Ψ′  t [ σ ]  t′ [ σ′ ]  T
    Λ-[]       : Ψ ⊢s σ  Γ  Γs 
                 (S  Γ)  Γs  t  T 
                 -------------------------------------
                 Ψ  Λ t [ σ ]  Λ (t [ q σ ])  S  T
    $-[]       : Ψ ⊢s σ  Ψ′ 
                 Ψ′  t  S  T 
                 Ψ′  s  S 
                 ----------------------------------------------
                 Ψ  t $ s [ σ ]  (t [ σ ]) $ (s [ σ ])  T
    box-[]     : Ψ ⊢s σ  Ψ′ 
                 [] ∷⁺ Ψ′  t  T 
                 ------------------------------------------
                 Ψ  box t [ σ ]  box (t [ σ  1 ])   T
    unbox-[]   :  {n} Γs 
                 Ψ ⊢s σ  Γs ++⁺ Ψ′ 
                 Ψ′  t   T 
                 len Γs  n 
                 ---------------------------------------------------------
                 Ψ  unbox n t [ σ ]  unbox (O σ n) (t [ Tr σ n ])  T
    ⟶-β        : (S  Γ)  Γs  t  T 
                 Γ  Γs  s  S 
                 --------------------------------------
                 Γ  Γs  Λ t $ s  t [ I , s ]  T
    □-β        :  {n} Γs 
                 [] ∷⁺ Ψ  t  T 
                 len Γs  n 
                 ------------------------------------------------
                 Γs ++⁺ Ψ  unbox n (box t)  t [ I  n ]  T
    ⟶-η        : Ψ  t  S  T 
                 -------------------------------------
                 Ψ  t  Λ ((t [ p ]) $ v 0)  S  T
    □-η        : Ψ  t   T 
                 -----------------------------
                 Ψ  t  box (unbox 1 t)   T
    [I]        : Ψ  t  T 
                 -------------------
                 Ψ  t [ I ]  t  T
    [∘]        : Ψ ⊢s σ  Ψ′ 
                 Ψ′ ⊢s σ′  Ψ″ 
                 Ψ″  t  T 
                 --------------------------------------
                 Ψ  t [ σ′  σ ]  t [ σ′ ] [ σ ]  T
    v-ze       : Ψ ⊢s σ  Γ  Γs 
                 Ψ  t  T 
                 --------------------------
                 Ψ  v 0 [ σ , t ]  t  T
    v-su       :  {x} 
                 Ψ ⊢s σ  Γ  Γs 
                 Ψ  t  S 
                 x  T  Γ 
                 -----------------------------------------
                 Ψ  v (suc x) [ σ , t ]  v x [ σ ]  T
    [p]        :  {x} 
                 x  T  Γ 
                 --------------------------------------
                 (S  Γ)  Γs  v x [ p ]  v (suc x)  T
    ≈-sym      : Ψ  t  t′  T 
                 ----------------
                 Ψ  t′  t  T
    ≈-trans    : Ψ  t  t′  T 
                 Ψ  t′  t″  T 
                 -----------------
                 Ψ  t  t″  T

  data _⊢s_≈_∶_ : Ctxs  Substs  Substs  Ctxs  Set where
    I-≈       : Ψ ⊢s I  I  Ψ
    p-≈       : (T  Γ)  Γs ⊢s p  p  Γ  Γs
    ,-cong    : Ψ ⊢s σ  σ′  Γ  Γs 
                Ψ  t  t′  T 
                -----------------------------------
                Ψ ⊢s σ , t  σ′ , t′  (T  Γ)  Γs
    ;-cong    :  {n} Γs 
                Ψ ⊢s σ  σ′  Ψ′ 
                len Γs  n 
                --------------------------------------
                Γs ++⁺ Ψ ⊢s σ  n  σ′  n  [] ∷⁺ Ψ′
    ∘-cong    : Ψ ⊢s δ  δ′  Ψ′ 
                Ψ′ ⊢s σ  σ′  Ψ″ 
                -------------------------
                Ψ ⊢s σ  δ  σ′  δ′  Ψ″
    ∘-I       : Ψ ⊢s σ  Ψ′ 
                ---------------------
                Ψ ⊢s σ  I  σ  Ψ′
    I-∘       : Ψ ⊢s σ  Ψ′ 
                ---------------------
                Ψ ⊢s I  σ  σ  Ψ′
    ∘-assoc   : Ψ ⊢s σ  Ψ′ 
                Ψ′ ⊢s σ′  Ψ″ 
                Ψ″ ⊢s σ″  Ψ‴ 
                -------------------------------------------
                Ψ ⊢s σ″  σ′  σ  σ″  (σ′  σ)  Ψ‴
    ,-∘       : Ψ′ ⊢s σ  Γ  Γs 
                Ψ′  t  T 
                Ψ ⊢s δ  Ψ′ 
                --------------------------------------------------------
                Ψ ⊢s (σ , t)  δ  (σ  δ) , t [ δ ]  (T  Γ)  Γs
    ;-∘       :  {n} Γs 
                Ψ ⊢s σ  Ψ′ 
                Ψ″ ⊢s δ  Γs ++⁺ Ψ 
                len Γs  n 
                --------------------------------------------------
                Ψ″ ⊢s σ  n  δ  (σ  Tr δ n)  O δ n  [] ∷⁺ Ψ′
    p-,       : Ψ ⊢s σ  Γ  Γs 
                Ψ  t  T 
                -----------------------------
                Ψ ⊢s p  (σ , t)  σ  Γ  Γs
    ,-ext     : Ψ ⊢s σ  (T  Γ)  Γs 
                ------------------------------------------
                Ψ ⊢s σ  (p  σ) , v 0 [ σ ]  (T  Γ)  Γs
    ;-ext     : Ψ ⊢s σ  []  Γ  Γs 
                -----------------------------------------
                Ψ ⊢s σ  Tr σ 1  O σ 1  []  Γ  Γs
    s-≈-sym   : Ψ ⊢s σ  σ′  Ψ′ 
                ------------------
                Ψ ⊢s σ′  σ  Ψ′
    s-≈-trans : Ψ ⊢s σ  σ′  Ψ′ 
                Ψ ⊢s σ′  σ″  Ψ′ 
                --------------------
                Ψ ⊢s σ  σ″  Ψ′

mutual
  data Ne : Set where
    v     : (x : )  Ne
    _$_   : Ne  (n : Nf)  Ne
    unbox :   Ne  Ne

  data Nf : Set where
    ne  : (u : Ne)  Nf
    Λ   : Nf  Nf
    box : Nf  Nf

pattern v′ x = ne (v x)

variable
  u u′ u″ : Ne
  w w′ w″ : Nf

mutual
  Ne⇒Exp : Ne  Exp
  Ne⇒Exp (v x)       = v x
  Ne⇒Exp (u $ w)     = Ne⇒Exp u $ Nf⇒Exp w
  Ne⇒Exp (unbox n c) = unbox n (Ne⇒Exp c)

  Nf⇒Exp : Nf  Exp
  Nf⇒Exp (ne u) = Ne⇒Exp u
  Nf⇒Exp (Λ w)  = Λ (Nf⇒Exp w)
  Nf⇒Exp (box w) = box (Nf⇒Exp w)