{-# 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)