------------------------------------------------------------------------
-- Weakening operations used by Definition.Typed.Decidable.Internal
------------------------------------------------------------------------

open import Definition.Typed.Restrictions
open import Graded.Modality

module Definition.Typed.Decidable.Internal.Weakening
  {a} {M : Set a}
  {𝕄 : Modality M}
  (R : Type-restrictions 𝕄)
  where

open import Definition.Typed.Decidable.Internal.Term R

open import Definition.Untyped M as U using (Wk)
open import Definition.Untyped.Properties M
import Definition.Untyped.Sup R as S

open Wk

open import Tools.Fin
open import Tools.Function
open import Tools.Maybe
open import Tools.Nat as N
open import Tools.Product as Ξ£
import Tools.PropositionalEquality as PE
open import Tools.Reasoning.PropositionalEquality

private variable
  n n₁ nβ‚‚ n₃ : Nat
  c          : Constants
  Ξ³          : Contexts _
  ρ          : Wk _ _
  Οƒ          : Subst _ _ _

------------------------------------------------------------------------
-- Composition

mutual

  -- Composition of weakenings and substitutions.

  infixl 30 _β€’β‚›_

  _β€’β‚›_ : Wk n₃ nβ‚‚ β†’ Subst c nβ‚‚ n₁ β†’ Subst c n₃ n₁
  id     β€’β‚› Οƒ        = Οƒ
  step ρ β€’β‚› Οƒ        = wk1 (ρ β€’β‚› Οƒ)
  lift ρ β€’β‚› id       = toSubst ρ ⇑
  lift ρ β€’β‚› Οƒ ⇑      = (ρ β€’β‚› Οƒ) ⇑
  lift ρ β€’β‚› wk1 Οƒ    = wk1 (ρ β€’β‚› Οƒ)
  ρ      β€’β‚› cons Οƒ t = cons (ρ β€’β‚› Οƒ) (weaken ρ t)

  -- Turns weakenings into substitutions.

  toSubst : Wk nβ‚‚ n₁ β†’ Subst c nβ‚‚ n₁
  toSubst ρ = ρ β€’β‚› id

opaque mutual

  -- The function ⌜_⌝˒ commutes with _β€’β‚›_/U._β€’β‚›_.

  βŒœβ€’β‚›βŒΛ’ : βˆ€ x β†’ ⌜ ρ β€’β‚› Οƒ ⌝˒ Ξ³ x PE.≑ (ρ U.β€’β‚› ⌜ Οƒ ⌝˒ Ξ³) x
  βŒœβ€’β‚›βŒΛ’ {ρ = id} {Οƒ} {Ξ³} x =
    ⌜ Οƒ ⌝˒ Ξ³ x              β‰‘Λ˜βŸ¨ wk-id _ ⟩
    U.wk U.id (⌜ Οƒ ⌝˒ Ξ³ x)  ∎
  βŒœβ€’β‚›βŒΛ’ {ρ = step ρ} {Οƒ} {Ξ³} x =
    U.wk1 (⌜ ρ β€’β‚› Οƒ ⌝˒ Ξ³ x)      β‰‘βŸ¨ PE.cong U.wk1 (βŒœβ€’β‚›βŒΛ’ _) ⟩
    U.wk1 ((ρ U.β€’β‚› ⌜ Οƒ ⌝˒ Ξ³) x)  β‰‘βŸ¨βŸ©
    U.wk1 (U.wk ρ (⌜ Οƒ ⌝˒ Ξ³ x))  β‰‘βŸ¨ wk1-wk _ _ ⟩
    U.wk (step ρ) (⌜ Οƒ ⌝˒ Ξ³ x)   ∎
  βŒœβ€’β‚›βŒΛ’ {ρ = lift _} {Οƒ = id} x0 =
    PE.refl
  βŒœβ€’β‚›βŒΛ’ {ρ = lift ρ} {Οƒ = id} {Ξ³} (x +1) =
    U.wk1 (⌜ toSubst ρ ⌝˒ Ξ³ x)  β‰‘βŸ¨ PE.cong U.wk1 (⌜toSubst⌝˒ x) ⟩
    U.wk1 (U.toSubst ρ x)       ∎
  βŒœβ€’β‚›βŒΛ’ {ρ = lift ρ} {Οƒ = wk1 Οƒ} {Ξ³} x =
    U.wk1 (⌜ ρ β€’β‚› Οƒ ⌝˒ Ξ³ x)             β‰‘βŸ¨ PE.cong U.wk1 (βŒœβ€’β‚›βŒΛ’ _) ⟩
    U.wk1 (U.wk ρ (⌜ Οƒ ⌝˒ Ξ³ x))         β‰‘βŸ¨ wk1-wk≑lift-wk1 _ _ ⟩
    U.wk (lift ρ) (U.wk1 (⌜ Οƒ ⌝˒ Ξ³ x))  ∎
  βŒœβ€’β‚›βŒΛ’ {ρ = lift _} {Οƒ = _ ⇑} x0 =
    PE.refl
  βŒœβ€’β‚›βŒΛ’ {ρ = lift ρ} {Οƒ = Οƒ ⇑} {Ξ³} (x +1) =
    U.wk1 (⌜ ρ β€’β‚› Οƒ ⌝˒ Ξ³ x)               β‰‘βŸ¨ PE.cong U.wk1 (βŒœβ€’β‚›βŒΛ’ _) ⟩
    U.wk1 (U.wk ρ (⌜ Οƒ ⌝˒ Ξ³ x))           β‰‘βŸ¨ wk1-wk≑lift-wk1 _ _ ⟩
    U.wk (U.lift ρ) (U.wk1 (⌜ Οƒ ⌝˒ Ξ³ x))  ∎
  βŒœβ€’β‚›βŒΛ’ {ρ = lift _} {Οƒ = cons _ _} x0 =
    PE.refl
  βŒœβ€’β‚›βŒΛ’ {ρ = ρ@(lift _)} {Οƒ = cons Οƒ _} {Ξ³} (x +1) =
    ⌜ ρ β€’β‚› Οƒ ⌝˒ Ξ³ x      β‰‘βŸ¨ βŒœβ€’β‚›βŒΛ’ {Οƒ = Οƒ} x ⟩
    U.wk ρ (⌜ Οƒ ⌝˒ Ξ³ x)  ∎

  -- The function ⌜_⌝˒ commutes with toSubst/U.toSubst.

  ⌜toSubst⌝˒ : βˆ€ x β†’ ⌜ toSubst ρ ⌝˒ Ξ³ x PE.≑ U.toSubst ρ x
  ⌜toSubst⌝˒ = βŒœβ€’β‚›βŒΛ’ {Οƒ = id}

------------------------------------------------------------------------
-- Weakening of terms

-- Weakening (lazy): This operation applies the weakening by pushing
-- it just below the term's top-level constructor.

wk : Wk nβ‚‚ n₁ β†’ Term c n₁ β†’ Term c nβ‚‚
wk ρ (meta-var x Οƒ)          = meta-var x (ρ β€’β‚› Οƒ)
wk ρ (weaken ρ′ t)           = weaken (ρ U.β€’ ρ′) t
wk ρ (subst t Οƒ)             = subst t (ρ β€’β‚› Οƒ)
wk ρ (var x)                 = var (U.wkVar ρ x)
wk ρ (defn α)                = defn α
wk ρ Empty                   = Empty
wk ρ (emptyrec p A t)        = emptyrec p (weaken ρ A) (weaken ρ t)
wk _ Level                   = Level
wk _ zeroᡘ                   = zeroᡘ
wk ρ (sucᡘ l)                = sucᡘ (weaken ρ l)
wk ρ (l₁ supα΅˜β‚— lβ‚‚)           = weaken ρ l₁ supα΅˜β‚— weaken ρ lβ‚‚
wk ρ (U l)                   = U (weaken ρ l)
wk ρ (Lift l A)              = Lift (weaken ρ l) (weaken ρ A)
wk ρ (lift l t)              = lift (weaken ρ <$> l) (weaken ρ t)
wk ρ (lower t)               = lower (weaken ρ t)
wk ρ (Unit s)                = Unit s
wk ρ (star s)                = star s
wk ρ (unitrec p q A t u)     = unitrec p q (weaken (lift ρ) A)
                                 (weaken ρ t) (weaken ρ u)
wk ρ (ΠΣ⟨ b ⟩ p , q β–· A β–Ή B) = ΠΣ⟨ b ⟩ p , q β–· weaken ρ A β–Ή
                               weaken (lift ρ) B
wk ρ (lam p qA t)            = lam p (Σ.map idᢠ (weaken ρ) <$> qA)
                                 (weaken (lift ρ) t)
wk ρ (t ∘⟨ p ⟩ u)            = weaken ρ t ∘⟨ p ⟩ weaken ρ u
wk ρ (prod s p qB t u)       = prod s p
                                 (Σ.map idᢠ (weaken (lift ρ)) <$> qB)
                                 (weaken ρ t) (weaken ρ u)
wk ρ (fst p t)               = fst p (weaken ρ t)
wk ρ (snd p t)               = snd p (weaken ρ t)
wk ρ (prodrec r p q A t u)   = prodrec r p q (weaken (lift ρ) A)
                                 (weaken ρ t) (weaken (U.liftn ρ 2) u)
wk ρ β„•                       = β„•
wk ρ zero                    = zero
wk ρ (suc t)                 = suc (weaken ρ t)
wk ρ (natrec p q r A t u v)  = natrec p q r (weaken (lift ρ) A)
                                 (weaken ρ t) (weaken (U.liftn ρ 2) u)
                                 (weaken ρ v)
wk ρ (Id A t u)              = Id (weaken ρ A) (weaken ρ t) (weaken ρ u)
wk ρ (rfl t)                 = rfl (weaken ρ <$> t)
wk ρ (J p q A t B u v w)     = J p q (weaken ρ A) (weaken ρ t)
                                 (weaken (U.liftn ρ 2) B) (weaken ρ u)
                                 (weaken ρ v) (weaken ρ w)
wk ρ (K p A t B u v)         = K p (weaken ρ A) (weaken ρ t)
                                 (weaken (lift ρ) B) (weaken ρ u)
                                 (weaken ρ v)
wk ρ ([]-cong s l A t u v)   = []-cong s (weaken ρ l) (weaken ρ A)
                                 (weaken ρ t) (weaken ρ u) (weaken ρ v)

opaque

  -- The function ⌜_⌝ commutes with weakening.

  ⌜wk⌝ : (t : Term c n) β†’ ⌜ wk ρ t ⌝ Ξ³ PE.≑ U.wk ρ (⌜ t ⌝ Ξ³)
  ⌜wk⌝ {ρ} {Ξ³} (meta-var x Οƒ) =
    ⌜ meta-var x (ρ β€’β‚› Οƒ) ⌝ Ξ³         β‰‘βŸ¨ ⌜meta-var⌝ (ρ β€’β‚› _) ⟩
    ⌜ x ⌝ᡐ Ξ³ U.[ ⌜ ρ β€’β‚› Οƒ ⌝˒ Ξ³ ]      β‰‘βŸ¨ substVar-to-subst βŒœβ€’β‚›βŒΛ’ (⌜ x ⌝ᡐ Ξ³) ⟩
    ⌜ x ⌝ᡐ Ξ³ U.[ ρ U.β€’β‚› ⌜ Οƒ ⌝˒ Ξ³ ]    β‰‘Λ˜βŸ¨ wk-subst (⌜ x ⌝ᡐ Ξ³) ⟩
    U.wk ρ (⌜ x ⌝ᡐ Ξ³ U.[ ⌜ Οƒ ⌝˒ Ξ³ ])  β‰‘Λ˜βŸ¨ PE.cong (U.wk _) (⌜meta-var⌝ Οƒ) ⟩
    U.wk ρ (⌜ meta-var x Οƒ ⌝ Ξ³)       ∎
  ⌜wk⌝ {ρ} {Ξ³} (weaken ρ′ t) =
    ⌜ weaken (ρ U.β€’ ρ′) t ⌝ Ξ³   β‰‘βŸ¨βŸ©
    U.wk (ρ U.β€’ ρ′) (⌜ t ⌝ Ξ³)   β‰‘Λ˜βŸ¨ wk-comp _ _ _ ⟩
    U.wk ρ (U.wk ρ′ (⌜ t ⌝ Ξ³))  ∎
  ⌜wk⌝ {ρ} {Ξ³} (subst t Οƒ) =
    ⌜ t ⌝ Ξ³ U.[ ⌜ ρ β€’β‚› Οƒ ⌝˒ Ξ³ ]      β‰‘βŸ¨ substVar-to-subst βŒœβ€’β‚›βŒΛ’ (⌜ t ⌝ _) ⟩
    ⌜ t ⌝ Ξ³ U.[ ρ U.β€’β‚› ⌜ Οƒ ⌝˒ Ξ³ ]    β‰‘Λ˜βŸ¨ wk-subst (⌜ t ⌝ _) ⟩
    U.wk ρ (⌜ t ⌝ Ξ³ U.[ ⌜ Οƒ ⌝˒ Ξ³ ])  ∎
  ⌜wk⌝ (var _) =
    PE.refl
  ⌜wk⌝ (defn _) =
    PE.refl
  ⌜wk⌝ Level =
    PE.refl
  ⌜wk⌝ zeroᡘ =
    PE.refl
  ⌜wk⌝ (sucᡘ _) =
    PE.refl
  ⌜wk⌝ {ρ} {Ξ³} (l₁ supα΅˜β‚— lβ‚‚) =
    U.wk ρ (⌜ l₁ ⌝ Ξ³) S.supα΅˜β‚— U.wk ρ (⌜ lβ‚‚ ⌝ Ξ³)  β‰‘Λ˜βŸ¨ S.wk-supα΅˜β‚— ⟩
    U.wk ρ (⌜ l₁ ⌝ Ξ³ S.supα΅˜β‚— ⌜ lβ‚‚ ⌝ Ξ³)           ∎
  ⌜wk⌝ (U _) =
    PE.refl
  ⌜wk⌝ (Lift _ _) =
    PE.refl
  ⌜wk⌝ (lift _ _) =
    PE.refl
  ⌜wk⌝ (lower _) =
    PE.refl
  ⌜wk⌝ Empty =
    PE.refl
  ⌜wk⌝ (emptyrec _ _ _) =
    PE.refl
  ⌜wk⌝ (Unit _) =
    PE.refl
  ⌜wk⌝ (star _) =
    PE.refl
  ⌜wk⌝ (unitrec _ _ _ _ _) =
    PE.refl
  ⌜wk⌝ (ΠΣ⟨ _ ⟩ _ , _ β–· _ β–Ή _) =
    PE.refl
  ⌜wk⌝ (lam _ _ _) =
    PE.refl
  ⌜wk⌝ (_ ∘⟨ _ ⟩ _) =
    PE.refl
  ⌜wk⌝ (prod _ _ _ _ _) =
    PE.refl
  ⌜wk⌝ (fst _ _) =
    PE.refl
  ⌜wk⌝ (snd _ _) =
    PE.refl
  ⌜wk⌝ (prodrec _ _ _ _ _ _) =
    PE.refl
  ⌜wk⌝ β„• =
    PE.refl
  ⌜wk⌝ zero =
    PE.refl
  ⌜wk⌝ (suc _) =
    PE.refl
  ⌜wk⌝ (natrec _ _ _ _ _ _ _) =
    PE.refl
  ⌜wk⌝ (Id _ _ _) =
    PE.refl
  ⌜wk⌝ (rfl _) =
    PE.refl
  ⌜wk⌝ (J _ _ _ _ _ _ _ _) =
    PE.refl
  ⌜wk⌝ (K _ _ _ _ _ _) =
    PE.refl
  ⌜wk⌝ ([]-cong _ _ _ _ _ _) =
    PE.refl

------------------------------------------------------------------------
-- A derived term former

-- Weakens a term the given number of steps.

wk[_] : βˆ€ k β†’ Term c n β†’ Term c (k N.+ n)
wk[ k ] t = weaken (U.stepn id k) t