{-# OPTIONS --cumulativity #-}
module ROmega.Terms.Syntax where

open import Agda.Primitive

open import ROmega.Types
open import ROmega.Types.Substitution
open import ROmega.Equivalence

open import ROmega.Entailment.Syntax

--------------------------------------------------------------------------------
-- Environments.

data Env : { : Level}  KEnv   Level  Set where
  ε :  {ℓΔ} {Δ : KEnv ℓΔ} 
        Env Δ lzero
  _,_ :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΓ ℓκ} 
          Env Δ ℓΓ  Ty Δ ( ℓκ)  Env Δ (ℓΓ  ℓκ)

-- Weakening of the kinding env.
weakΓ :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΓ ℓκ} {κ : Kind ℓκ} 
        Env Δ ℓΓ  Env (Δ , κ) ℓΓ
weakΓ ε = ε
weakΓ (Γ , τ) = weakΓ Γ , rename S τ

--------------------------------------------------------------------------------
-- Variables.

data Var :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΓ ℓκ} {κ : Kind ℓκ} 
           Env Δ ℓΓ  Ty Δ κ  Set where
  Z :  {ℓΔ : Level} {Δ : KEnv ℓΔ} {ℓΓ}
        {Γ : Env Δ ℓΓ} {ℓτ} {τ : Ty Δ ( ℓτ)} 
        Var (Γ , τ) τ
  S :  {ℓΔ : Level} {Δ : KEnv ℓΔ} {ℓΓ} {Γ : Env Δ ℓΓ}
        {ℓυ ℓτ} {τ : Ty Δ ( ℓτ)} {υ : Ty Δ ( ℓυ)} 
         Var Γ υ  Var (Γ , τ) υ        

--------------------------------------------------------------------------------
-- Synonyms, used later.

SynT :  {ℓΔ ℓκ} {Δ : KEnv ℓΔ} 
       (κ : Kind ℓκ)  (ρ : Ty Δ R[ κ ]) 
       (φ : Ty Δ (κ `→  ℓκ))  Ty Δ ( (ℓΔ  (lsuc ℓκ)))
SynT {ℓΔ} {ℓκ} κ ρ φ =
  `∀ L (`∀ κ (`∀ R[ κ ] ((l R▹ u) · y ~ ρ'   (_`→_ {ℓ₂ = ℓΔ}  l  (φ' ·[ u ])))))
    where
      ρ' = weaken (weaken (weaken ρ))
      φ' = weaken (weaken (weaken φ))
      y = tvar Z
      u = tvar (S Z)
      l = tvar (S (S Z))

AnaT :  {ℓΔ ℓκ ℓτ} {Δ : KEnv ℓΔ} 
       (κ : Kind ℓκ)  (ρ : Ty Δ R[ κ ])
       (φ : Ty Δ (κ `→  ℓκ)) (τ : Ty Δ ( ℓτ)) 
       Ty Δ ( (ℓΔ  ℓτ  lsuc ℓκ))
AnaT {ℓΔ} {ℓκ} {ℓτ} κ ρ φ τ  =
  `∀ L (`∀ κ (`∀ R[ κ ] ((l R▹ u) · y ~ ρ'  
    (_`→_ {ℓ₂ = ℓΔ}  l  ((φ' ·[ u ]) `→ τ')))))
    where
      ρ' = weaken (weaken (weaken ρ))
      φ' = weaken (weaken (weaken φ))
      τ' = weaken (weaken (weaken τ))
      y = tvar Z
      u = tvar (S Z)
      l = tvar (S (S Z))

FoldT :  {ℓΔ ℓκ ℓυ} {Δ : KEnv ℓΔ} 
       (ρ : Ty Δ R[  ℓκ ])(υ : Ty Δ ( ℓυ)) 
       Ty Δ ( (ℓυ  lsuc ℓκ))
FoldT {ℓκ = ℓκ} ρ υ =
  `∀ L (`∀ ( ℓκ) (`∀ R[  ℓκ ]
    (((l R▹ t) · y ~ weaken (weaken (weaken ρ))) 
       l  `→ (t `→ (weaken (weaken (weaken υ)))))))
    where
      y = tvar Z
      t = tvar (S Z)
      l = tvar (S (S Z))

--------------------------------------------------------------------------------
-- Terms.

data Tm :  {ℓΔ} (Δ : KEnv ℓΔ) {ℓΦ ℓΓ ℓτ}  PEnv Δ ℓΦ  Env Δ ℓΓ  Ty Δ ( ℓτ)  Set where
  ------------------------------------------------------------
  -- System Fω.

  var :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΦ ℓΓ ℓτ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ} {τ : Ty Δ ( ℓτ)} 

           Var Γ τ 
           -------------
           Tm Δ Φ Γ τ

   :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΦ ℓΓ ℓτ ℓυ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ} {υ : Ty Δ ( ℓυ)}

           (τ : Ty Δ ( ℓτ))  Tm Δ Φ (Γ , τ) υ 
           -------------------------------------
           Tm Δ Φ Γ (τ `→ υ)

  _·_ :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΦ ℓΓ ℓτ ℓυ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ} {τ : Ty Δ ( ℓτ)} {υ : Ty Δ ( ℓυ)} 

           Tm Δ Φ Γ (τ `→ υ)  Tm Δ Φ Γ τ 
           ----------------------------
           Tm Δ Φ Γ υ

   :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΦ ℓΓ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ}
         {ℓκ ℓτ} (κ : Kind ℓκ) {τ : Ty (Δ , κ) ( ℓτ)} 

       Tm (Δ , κ) (weakΦ Φ) (weakΓ Γ) τ 
       ----------------------------------------------------
       Tm Δ Φ Γ (`∀ κ τ)


  _·[_] :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΦ ℓΓ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ} {ℓκ ℓτ}
            {κ : Kind ℓκ} {τ : Ty (Δ , κ) ( ℓτ)} 

           Tm Δ Φ Γ (`∀ κ τ)  (υ : Ty Δ κ) 
           ----------------------------------
           Tm Δ Φ Γ (τ β[ υ ])

  ------------------------------------------------------------
  -- Qualified types.

   :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΦ ℓΓ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ}
          {ℓκ ℓτ} {κ : Kind ℓκ} {τ : Ty Δ ( ℓτ)} 

           (π : Pred Δ κ)  Tm Δ (Φ , π) Γ τ 
           -------------------------------------
           Tm Δ Φ Γ (π  τ)

  _·⟨_⟩ :  {ℓΔ} {Δ : KEnv ℓΔ} {ℓΦ ℓΓ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ}
         {ℓκ ℓτ} {κ : Kind ℓκ} {π : Pred Δ κ} {τ : Ty Δ ( ℓτ)} 

         Tm Δ Φ Γ (π  τ)  Ent Δ Φ π 
         ----------------------------------
         Tm Δ Φ Γ τ
              
  ------------------------------------------------------------
  -- System Rω.

  -- labels.
  lab :  {ℓΔ ℓΓ ℓΦ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
          (l : Ty Δ L)  
          ----------------------------------------
          Tm Δ Φ Γ  l 
  

  -- singleton introduction.
  _▹_ :  {ℓΔ ℓΓ ℓΦ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {τ : Ty Δ L} {υ : Ty Δ ( ℓκ)} 
        
          (M₁ : Tm Δ Φ Γ  τ )(M₂ : Tm Δ Φ Γ υ) 
          ----------------------------------------
          Tm Δ Φ Γ (τ  υ)          

  -- singleton elimination.
  _/_ :  {ℓΔ ℓΓ ℓΦ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {τ : Ty Δ L} {υ : Ty Δ ( ℓκ)} 
        
          (M₁ : Tm Δ Φ Γ (τ  υ)) (M₂ : Tm Δ Φ Γ  τ ) 
          ----------------------------------------
          Tm Δ Φ Γ υ

  -- The empty record.
  -- (Not a part of pen-and-paper calculus.)
   :  {ℓΔ ℓΓ ℓΦ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ} 

        -----------
        Tm Δ Φ Γ  

  -- record introduction.
  _⊹_ :  {ℓΔ ℓΓ ℓΦ ℓρ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {ρ₁ ρ₂ ρ₃ : Ty Δ (R[  ℓρ ])} 
      
          (M : Tm Δ Φ Γ (Π ρ₁)) (N : Tm Δ Φ Γ (Π ρ₂)) 
          (π : Ent Δ Φ (ρ₁ · ρ₂ ~ ρ₃)) 
          ------------------------------
          Tm Δ Φ Γ (Π ρ₃)
  
  -- record "elimination".
  prj :  {ℓΔ ℓΓ ℓΦ ℓρ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {ρ₁ ρ₂ : Ty Δ (R[  ℓρ ])} 
        
          (M : Tm Δ Φ Γ (Π ρ₁))  (π : Ent Δ Φ (ρ₂  ρ₁)) 
          ------------------------------
          Tm Δ Φ Γ (Π ρ₂)

  -- Singleton → Singleton Record.
  Π :  {ℓΔ ℓΓ ℓΦ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {τ : Ty Δ L} {υ : Ty Δ ( ℓκ)} 
        
          Tm Δ Φ Γ (τ  υ) 
          ---------------------
          Tm Δ Φ Γ (Π (τ R▹ υ))

  -- Singleton Record → Singleton.
  Π⁻¹ :  {ℓΔ ℓΓ ℓΦ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {τ : Ty Δ L} {υ : Ty Δ ( ℓκ)} 
        
          (M : Tm Δ Φ Γ (Π (τ R▹ υ))) 
          ----------------------------------------
          Tm Δ Φ Γ (τ  υ)
          
  -- Subsumption.
  t-≡ :  {ℓΔ ℓΦ ℓΓ ℓτ} { Δ : KEnv ℓΔ} {Φ : PEnv Δ ℓΦ} {Γ : Env Δ ℓΓ}
        {τ υ : Ty Δ ( ℓτ)}  

          (M : Tm Δ Φ Γ τ)  τ ≡t υ 
          ----------------------------
          Tm Δ Φ Γ υ

  -- Variant introduction.
  inj :  {ℓΔ ℓΓ ℓΦ ℓρ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {ρ₁ ρ₂ : Ty Δ (R[  ℓρ ])} 
      
          (M : Tm Δ Φ Γ (Σ ρ₁))  (Ent Δ Φ (ρ₁  ρ₂)) 
          ----------------------------------------------
          Tm Δ Φ Γ (Σ ρ₂)

  -- Singleton Record → Singleton.
  Σ :  {ℓΔ ℓΓ ℓΦ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {τ : Ty Δ L} {υ : Ty Δ ( ℓκ)} 
        
          Tm Δ Φ Γ (τ  υ) 
          ---------------------
          Tm Δ Φ Γ (Σ (τ R▹ υ))
          
  -- Singleton Variant → Singleton.
  Σ⁻¹ :  {ℓΔ ℓΓ ℓΦ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {τ : Ty Δ L} {υ : Ty Δ ( ℓκ)} 
        
          (M : Tm Δ Φ Γ (Σ (τ R▹ υ))) 
          ----------------------------------------
          Tm Δ Φ Γ (τ  υ)
           
  -- Variant elimination.
  _▿_ :  {ℓΔ ℓΓ ℓΦ ℓρ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
        {ρ₁ ρ₂ ρ₃ : Ty Δ (R[  ℓρ ])} {τ : Ty Δ ( ℓκ)} 
      
          Tm Δ Φ Γ ((Σ ρ₁) `→ τ) 
          Tm Δ Φ Γ ((Σ ρ₂) `→ τ) 
          Ent Δ Φ (ρ₁ · ρ₂ ~ ρ₃) 
          ------------------------------
          Tm Δ Φ Γ ((Σ ρ₃) `→ τ)
           
  -- Synthesis.
  syn :  {ℓΔ ℓΓ ℓΦ ℓκ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ} {κ : Kind ℓκ}
  
         (ρ : Ty Δ R[ κ ]) 
         (φ : Ty Δ (κ `→  ℓκ)) 
         Tm Δ Φ Γ (SynT κ ρ φ) 
         --------------------------
         Tm Δ Φ Γ (Π ( φ ⌉· ρ))

  -- Analysis.
  ana :  {ℓΔ ℓΓ ℓΦ ℓκ ℓτ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ} {κ : Kind ℓκ}
  
         (ρ : Ty Δ R[ κ ]) 
         (φ : Ty Δ (κ `→  ℓκ)) 
         (τ : Ty Δ ( ℓτ)) 
         Tm Δ Φ Γ (AnaT κ ρ φ τ) 
         --------------------------
         Tm Δ Φ Γ (Σ ( φ ⌉· ρ) `→ τ)

  -- Fold.
  fold :  {ℓΔ ℓΓ ℓΦ ℓκ ℓυ} {Δ : KEnv ℓΔ} {Γ : Env Δ ℓΓ} {Φ : PEnv Δ ℓΦ}
         {ρ : Ty Δ R[  ℓκ ]} {υ : Ty Δ ( ℓυ)} 
         (M₁ : Tm Δ Φ Γ (FoldT ρ υ)) 
         (M₂ : Tm Δ Φ Γ (υ `→ (υ `→ υ))) 
         (M₃ : Tm Δ Φ Γ υ) 
         (N  : Tm Δ Φ Γ (Π ρ)) 
         ------------------------
         Tm Δ Φ Γ υ

--------------------------------------------------------------------------------
-- admissable rules.

private
  variable
    ℓΔ ℓΓ ℓΦ ℓκ ℓτ : Level
    Δ : KEnv ℓΔ
    Γ : Env Δ ℓΓ
    Φ : PEnv Δ ℓΦ
    κ : Kind ℓκ
    Ł : Ty Δ L
    τ : Ty Δ κ

prj▹ : {ρ : Ty Δ R[  ℓκ ]}           
        Tm Δ Φ Γ (Π ρ)  Ent Δ Φ ((Ł R▹ τ)  ρ) 
        ------------------------------------------
        Tm Δ Φ Γ (Ł  τ)
prj▹ r e = Π⁻¹ (prj r e)          

inj▹ : {ρ : Ty Δ R[  ℓκ ]}           
        Tm Δ Φ Γ (Ł  τ)  Ent Δ Φ ((Ł R▹ τ)  ρ) 
        ---------------------------------------------
        Tm Δ Φ Γ (Σ ρ)
inj▹ s e = inj (Σ s) e