-- Andreas, 2018-09-03, issue #3200 reported by gallais
--
-- Record let pattern bindings trigger spurious irrelevance
-- marker, probably due to confusion of Prop with dummy type.

-- {-# OPTIONS -v tc.term.let.pattern:100 #-}
-- {-# OPTIONS -v tc.lhs.top:30 #-}

open import Agda.Builtin.Bool
open import Agda.Builtin.Unit

record R : Set where
  field
    fld : Bool

data Maybe (A : Set) : Set where
  just : A → Maybe A
  nothing : Maybe A

case_of_ : ∀ {a b} {A : Set a} {B : Set b} → A → (A → B) → B
case x of f = f x

solve2 : Maybe (Bool → Bool)
solve2 =
  let record { fld = bla } = record { fld = true } in
  case true of λ where
    true → just (λ x → true)
    false → nothing

From-just : {A : Set} → Maybe A → Set
From-just {A} (just _) = A
From-just nothing  = ⊤

from-just : {A : Set} (x : Maybe A) → From-just x
from-just (just x) = x
from-just nothing  = _

test : Bool
test = from-just solve2 true

-- Error was:
--
-- From-just .((just (λ x → true))) should be a function type, but it isn't
-- when checking that true is a valid argument to a function of type
-- From-just solve2


open import Prelude
open import Nat
open import core
open import contexts
open import weakening
open import exchange
open import lemmas-disjointness
open import binders-disjoint-checks

module lemmas-subst-ta where
  -- this is what makes the binders-unique assumption below good enough: it
  -- tells us that we can pick fresh variables
  mutual
    binders-envfresh : ∀{Δ Γ Γ' y σ} → Δ , Γ ⊢ σ :s: Γ' → y # Γ → unbound-in-σ y σ → binders-unique-σ σ → envfresh y σ
    binders-envfresh {Γ' = Γ'} {y = y} (STAId x) apt unbound unique with ctxindirect Γ' y
    binders-envfresh {Γ' = Γ'} {y = y} (STAId x₁) apt unbound unique | Inl x = abort (somenotnone (! (x₁ y (π1 x) (π2 x)) · apt))
    binders-envfresh (STAId x₁) apt unbound unique | Inr x = EFId x
    binders-envfresh {Γ = Γ} {y = y} (STASubst  {y = z} subst x₁) apt (UBσSubst x₂ unbound neq) (BUσSubst zz x₃ x₄) =
                                                                                EFSubst (binders-fresh {y = y} x₁ zz x₂ apt)
                                                                                (binders-envfresh subst (apart-extend1 Γ neq apt) unbound x₃)
                                                                                neq

    binders-fresh : ∀{ Δ Γ d2 τ y} → Δ , Γ ⊢ d2 :: τ
                                      → binders-unique d2
                                      → unbound-in y d2
                                      → Γ y == None
                                      → fresh y d2
    binders-fresh TAConst BUHole UBConst apt = FConst
    binders-fresh {y = y} (TAVar {x = x} x₁)  BUVar UBVar apt with natEQ y x
    binders-fresh (TAVar x₂) BUVar UBVar apt | Inl refl = abort (somenotnone (! x₂ · apt))
    binders-fresh (TAVar x₂) BUVar UBVar apt | Inr x₁ = FVar x₁
    binders-fresh {y = y} (TALam {x = x} x₁ wt) bu2 ub apt  with natEQ y x
    binders-fresh (TALam x₂ wt) bu2 (UBLam2 x₁ ub) apt | Inl refl = abort (x₁ refl)
    binders-fresh {Γ = Γ} (TALam {x = x} x₂ wt) (BULam bu2 x₃) (UBLam2 x₄ ub) apt | Inr x₁ =  FLam x₁ (binders-fresh wt bu2 ub (apart-extend1 Γ x₄ apt))
    binders-fresh (TAAp wt wt₁)  (BUAp bu2 bu3 x) (UBAp ub ub₁) apt = FAp (binders-fresh wt bu2 ub apt) (binders-fresh wt₁ bu3 ub₁ apt)
    binders-fresh (TAEHole x₁ x₂) (BUEHole x) (UBHole x₃) apt = FHole (binders-envfresh x₂ apt x₃ x )
    binders-fresh (TANEHole x₁ wt x₂) (BUNEHole bu2 x) (UBNEHole x₃ ub) apt = FNEHole (binders-envfresh x₂ apt x₃ x) (binders-fresh wt bu2  ub apt)
    binders-fresh (TACast wt x₁) (BUCast bu2) (UBCast ub) apt = FCast (binders-fresh wt  bu2  ub apt)
    binders-fresh (TAFailedCast wt x x₁ x₂) (BUFailedCast bu2) (UBFailedCast ub) apt = FFailedCast (binders-fresh wt  bu2  ub apt)

  -- the substition lemma for preservation
  lem-subst : ∀{Δ Γ x τ1 d1 τ d2 } →
                  x # Γ →
                  binders-disjoint d1 d2 →
                  binders-unique d2 →
                  Δ , Γ ,, (x , τ1) ⊢ d1 :: τ →
                  Δ , Γ ⊢ d2 :: τ1 →
                  Δ , Γ ⊢ [ d2 / x ] d1 :: τ
  lem-subst apt bd bu2  TAConst wt2 = TAConst
  lem-subst {x = x} apt bd bu2  (TAVar {x = x'} x₂) wt2 with natEQ x' x
  lem-subst {Γ = Γ} apt bd bu2 (TAVar x₃) wt2 | Inl refl with lem-apart-union-eq {Γ = Γ} apt x₃
  lem-subst apt bd bu2  (TAVar x₃) wt2 | Inl refl | refl = wt2
  lem-subst {Γ = Γ} apt bd bu2  (TAVar x₃) wt2 | Inr x₂ = TAVar (lem-neq-union-eq {Γ = Γ} x₂ x₃)
  lem-subst {Δ = Δ} {Γ = Γ} {x = x} {d2 = d2} x#Γ (BDLam bd bd') bu2 (TALam {x = y} {τ1 = τ1} {d = d} {τ2 = τ2} x₂ wt1) wt2
    with lem-union-none {Γ = Γ} x₂
  ... |  x≠y , y#Γ with natEQ y x
  ... | Inl eq = abort (x≠y (! eq))
  ... | Inr _  = TALam y#Γ (lem-subst {Δ = Δ} {Γ = Γ ,, (y , τ1)} {x = x} {d1 = d} (apart-extend1 Γ x≠y x#Γ) bd bu2 (exchange-ta-Γ {Γ = Γ} x≠y wt1)
                                         (weaken-ta (binders-fresh wt2 bu2 bd' y#Γ) wt2))
  lem-subst apt (BDAp bd bd₁) bu3 (TAAp wt1 wt2) wt3 = TAAp (lem-subst apt bd bu3 wt1 wt3) (lem-subst apt bd₁ bu3 wt2 wt3)
  lem-subst apt bd bu2 (TAEHole inΔ sub) wt2 = TAEHole inΔ (STASubst sub wt2)
  lem-subst apt (BDNEHole x₁ bd) bu2 (TANEHole x₃ wt1 x₄) wt2 = TANEHole x₃ (lem-subst apt bd bu2 wt1 wt2) (STASubst x₄ wt2)
  lem-subst apt (BDCast bd) bu2 (TACast wt1 x₁) wt2 = TACast (lem-subst apt bd bu2 wt1 wt2) x₁
  lem-subst apt (BDFailedCast bd) bu2 (TAFailedCast wt1 x₁ x₂ x₃) wt2 = TAFailedCast (lem-subst apt bd bu2 wt1 wt2) x₁ x₂ x₃


{-# OPTIONS --allow-unsolved-metas #-}

data ⊤ : Set where
  tt : ⊤

data _≡_ (a : ⊤) : {B : Set} → B → Set where
  refl : a ≡ a

foo : ⊤
foo = (λ (z : ⊤) (q : bar ≡ {!!}) → tt) bar refl
  where
    bar : ⊤
    bar = {!!}


{-# OPTIONS --erased-cubical #-}

open import Agda.Builtin.Bool
open import Agda.Builtin.Cubical.Path
open import Agda.Primitive
open import Agda.Primitive.Cubical

private
  variable
    a p : Level
    A   : Set a
    P   : A → Set p
    x y : A

refl : x ≡ x
refl {x = x} = λ _ → x

subst : (P : A → Set p) → x ≡ y → P x → P y
subst P eq p = primTransp (λ i → P (eq i)) i0 p

record Erased (@0 A : Set a) : Set a where
  constructor [_]
  field
    @0 erased : A

[]-cong : {@0 A : Set a} {@0 x y : A} → @0 x ≡ y → [ x ] ≡ [ y ]
[]-cong eq = λ i → [ eq i ]

data Box : @0 Set → Set₁ where
  [_] : ∀ {A} → A → Box A

unbox : ∀ {@0 A} → Box A → A
unbox [ x ] = x

postulate
  @0 not : Bool ≡ Bool

should-be-true : Bool
should-be-true =
  unbox (subst (λ ([ A ]) → Box A) ([]-cong refl) [ true ])

should-be-false : Bool
should-be-false =
  unbox (subst (λ ([ A ]) → Box A) ([]-cong not) [ true ])


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

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.Escape {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

open import Definition.Untyped
open import Definition.Untyped.Properties

open import Definition.Typed

open import Definition.LogicalRelation
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Substitution
open import Definition.LogicalRelation.Substitution.Properties

open import Tools.Product

-- Valid types are well-formed.
escapeᵛ : ∀ {A l Γ} ([Γ] : ⊩ᵛ Γ) → Γ ⊩ᵛ⟨ l ⟩ A / [Γ] → Γ ⊢ A
escapeᵛ [Γ] [A] =
  let ⊢Γ = soundContext [Γ]
      idSubst = idSubstS [Γ]
  in  escape (irrelevance′ (subst-id _) (proj₁ ([A] ⊢Γ idSubst)))

-- Valid type equality respects the equality relation.
escapeEqᵛ : ∀ {A B l Γ} ([Γ] : ⊩ᵛ Γ) ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ])
              → Γ ⊩ᵛ⟨ l ⟩ A ≡ B / [Γ] / [A] → Γ ⊢ A ≅ B
escapeEqᵛ [Γ] [A] [A≡B] =
  let ⊢Γ = soundContext [Γ]
      idSubst = idSubstS [Γ]
      [idA]  = proj₁ ([A] ⊢Γ idSubst)
      [idA]′ = irrelevance′ (subst-id _) [idA]
  in  escapeEq [idA]′ (irrelevanceEq″ (subst-id _) (subst-id _)
                                           [idA] [idA]′ ([A≡B] ⊢Γ idSubst))

-- Valid terms are well-formed.
escapeTermᵛ : ∀ {t A l Γ} ([Γ] : ⊩ᵛ Γ) ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ])
               → Γ ⊩ᵛ⟨ l ⟩ t ∷ A / [Γ] / [A] → Γ ⊢ t ∷ A
escapeTermᵛ [Γ] [A] [t] =
  let ⊢Γ = soundContext [Γ]
      idSubst = idSubstS [Γ]
      [idA]  = proj₁ ([A] ⊢Γ idSubst)
      [idA]′ = irrelevance′ (subst-id _) (proj₁ ([A] ⊢Γ idSubst))
  in  escapeTerm [idA]′
                    (irrelevanceTerm″ (subst-id _) (subst-id _)
                                       [idA] [idA]′ (proj₁ ([t] ⊢Γ idSubst)))

-- Valid term equality respects the equality relation.
escapeEqTermᵛ : ∀ {t u A l Γ} ([Γ] : ⊩ᵛ Γ) ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ])
               → Γ ⊩ᵛ⟨ l ⟩ t ≡ u ∷ A / [Γ] / [A] → Γ ⊢ t ≅ u ∷ A
escapeEqTermᵛ [Γ] [A] [t≡u] =
  let ⊢Γ = soundContext [Γ]
      idSubst = idSubstS [Γ]
      [idA]  = proj₁ ([A] ⊢Γ idSubst)
      [idA]′ = irrelevance′ (subst-id _) (proj₁ ([A] ⊢Γ idSubst))
  in  escapeTermEq [idA]′
                       (irrelevanceEqTerm″ (subst-id _) (subst-id _)
                                            (subst-id _)
                                            [idA] [idA]′ ([t≡u] ⊢Γ idSubst))


module string where

open import bool
open import eq
open import char
open import list
open import nat
open import unit

----------------------------------------------------------------------
-- datatypes
----------------------------------------------------------------------

postulate
  string : Set

{-# BUILTIN STRING string #-}

private
 primitive
  primStringToList   : string → 𝕃 char
  primStringAppend   : string → string → string
  primStringFromList : 𝕃 char → string
  primStringEquality : string → string → 𝔹

-- see string-thms.agda for some axioms about the above primitive functions

----------------------------------------------------------------------
-- syntax
----------------------------------------------------------------------

infixr 6 _^_
infix 8 _=string_

----------------------------------------------------------------------
-- operations
----------------------------------------------------------------------

_^_ : string → string → string
_^_ = primStringAppend

string-to-𝕃char : string → 𝕃 char
string-to-𝕃char = primStringToList

𝕃char-to-string : 𝕃 char → string
𝕃char-to-string = primStringFromList

_=string_ : string → string → 𝔹
_=string_ = primStringEquality

char-to-string : char → string
char-to-string c = 𝕃char-to-string [ c ]

string-append-t : ℕ → Set
string-append-t 0 = string → string
string-append-t (suc n) = string → (string-append-t n)

string-append-h : (n : ℕ) → string → string-append-t n
string-append-h 0 ret = λ x → ret ^ x
string-append-h (suc n) ret = λ x → (string-append-h n (ret ^ x))

string-append : (n : ℕ) → string-append-t n
string-append n = string-append-h n ""

string-concat : 𝕃 string → string
string-concat [] = ""
string-concat (s :: ss) = s ^ (string-concat ss)

string-concat-sep : (separator : string) → 𝕃 string → string
string-concat-sep sep [] = ""
string-concat-sep sep (s1 :: ss) with ss
... | [] = s1
... | s2 :: ss' = s1 ^ sep ^ (string-concat-sep sep ss)

string-concat-sep-map : ∀{A : Set} → (separator : string) → (A → string) → 𝕃 A → string
string-concat-sep-map sep f l = string-concat-sep sep (map f l)

escape-string-h : 𝕃 char → 𝕃 char
escape-string-h ('\n' :: cs) = '\\' :: 'n' :: (escape-string-h cs)
escape-string-h ('"' :: cs) = '\\' :: '"' :: (escape-string-h cs)
escape-string-h (c :: cs) = c :: escape-string-h cs
escape-string-h [] = []

escape-string : string → string
escape-string s = 𝕃char-to-string( escape-string-h( string-to-𝕃char s ) )

string-length : string → ℕ
string-length s = length (string-to-𝕃char s)


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

open import lib.Base
open import lib.PathGroupoid
open import lib.cubical.Square

module lib.cubical.Cube where

{- Coordinates are yzx, where
     x : left -> right
     y : back -> front
     z : top  -> bottom
 -}

data Cube {i} {A : Type i} {a₀₀₀ : A} :
  {a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  (sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀) -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  (sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁) -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  (sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁) -- back
  (sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁) -- top
  (sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁) -- bottom
  (sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁) -- front
  → Type i

  where
  idc : Cube ids ids ids ids ids ids

{- Just transport, but less clutter to use -}
module _ {i} {A : Type i} {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  {sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁} -- back
  {sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁} -- top
  {sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁} -- bottom
  {sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁} -- front
  where

  cube-shift-left : {sq₋₋₀' : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀}
    → sq₋₋₀ == sq₋₋₀'
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
    → Cube sq₋₋₀' sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  cube-shift-left idp cu = cu

  cube-shift-right : {sq₋₋₁' : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁}
    → sq₋₋₁ == sq₋₋₁'
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
    → Cube sq₋₋₀ sq₋₋₁' sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  cube-shift-right idp cu = cu

  cube-shift-back : {sq₀₋₋' : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁}
    → sq₀₋₋ == sq₀₋₋'
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋' sq₋₀₋ sq₋₁₋ sq₁₋₋
  cube-shift-back idp cu = cu

  cube-shift-top : {sq₋₀₋' : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁}
    → sq₋₀₋ == sq₋₀₋'
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋' sq₋₁₋ sq₁₋₋
  cube-shift-top idp cu = cu

  cube-shift-bot : {sq₋₁₋' : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁}
    → sq₋₁₋ == sq₋₁₋'
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋' sq₁₋₋
  cube-shift-bot idp cu = cu

  cube-shift-front : {sq₁₋₋' : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁}
    → sq₁₋₋ == sq₁₋₋'
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
    → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋'
  cube-shift-front idp cu = cu

{- A cube where two opposite squares are both [ids] is a square -}
module _ {i} {A : Type i} where

  x-id-cube-in : {a₀ a₁ : A} {p₀₀ p₀₁ p₁₀ p₁₁ : a₀ == a₁}
    {α₀₋ : p₀₀ == p₁₀} {α₁₋ : p₀₁ == p₁₁}
    {α₋₀ : p₀₀ == p₀₁} {α₋₁ : p₁₀ == p₁₁}
    → Square α₀₋ α₋₀ α₋₁ α₁₋
    → Cube ids ids (vert-degen-square α₀₋) (vert-degen-square α₋₀)
           (vert-degen-square α₋₁) (vert-degen-square α₁₋)
  x-id-cube-in {p₀₀ = idp} ids = idc

  y-id-cube-in : {a₀ a₁ : A} {p₀₀ p₀₁ p₁₀ p₁₁ : a₀ == a₁}
    {α₀₋ : p₀₀ == p₁₀} {α₁₋ : p₀₁ == p₁₁}
    {α₋₀ : p₀₀ == p₀₁} {α₋₁ : p₁₀ == p₁₁}
    → Square α₀₋ α₋₀ α₋₁ α₁₋
    → Cube (vert-degen-square α₀₋) (vert-degen-square α₁₋)
           ids (horiz-degen-square α₋₀) (horiz-degen-square α₋₁) ids
  y-id-cube-in {p₀₀ = idp} ids = idc

  z-id-cube-in : {a₀ a₁ : A} {p₀₀ p₁₀ p₀₁ p₁₁ : a₀ == a₁}
    {α₀₋ : p₀₀ == p₁₀} {α₁₋ : p₀₁ == p₁₁}
    {α₋₀ : p₀₀ == p₀₁} {α₋₁ : p₁₀ == p₁₁}
    → Square α₀₋ α₋₀ α₋₁ α₁₋
    → Cube (horiz-degen-square α₀₋) (horiz-degen-square α₁₋)
           (horiz-degen-square α₋₀) ids ids (horiz-degen-square α₋₁)
  z-id-cube-in {p₀₀ = idp} ids = idc

{- Cube fillers -}
module _ {i} {A : Type i} where
  fill-cube-left : {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
    {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
    {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
    -- missing left

    {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
    {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
    (sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁) -- right

    {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
    {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
    (sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁) -- back
    (sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁) -- top
    (sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁) -- bottom
    (sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁) -- front
    → Σ (Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀)
        (λ sq₋₋₀ → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋)
  fill-cube-left {p₋₀₀ = p₋₀₀} {p₋₁₀ = p₋₁₀} sq₋₋₁ ids sq₋₀₋ sq₋₁₋ ids =
    (_ ,
     cube-shift-right (vert-degen-square-β sq₋₋₁)
       (cube-shift-top (horiz-degen-square-β sq₋₀₋)
         (cube-shift-bot (horiz-degen-square-β sq₋₁₋)
           cu)))
    where
    fill-sq : Σ (p₋₀₀ == p₋₁₀) (λ α₋₋₀ →
      Square α₋₋₀ (horiz-degen-path sq₋₀₋)
             (horiz-degen-path sq₋₁₋) (vert-degen-path sq₋₋₁))
    fill-sq = fill-square-left _ _ _

    cu : Cube (vert-degen-square (fst fill-sq))
              (vert-degen-square (vert-degen-path sq₋₋₁)) ids
              (horiz-degen-square (horiz-degen-path sq₋₀₋))
              (horiz-degen-square (horiz-degen-path sq₋₁₋)) ids
    cu = y-id-cube-in (snd fill-sq)

  fill-cube-right : {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
    {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
    {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
    (sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀) -- left

    {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
    {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
    -- missing right

    {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
    {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
    (sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁) -- back
    (sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁) -- top
    (sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁) -- bottom
    (sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁) -- front
    → Σ (Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁)
        (λ sq₋₋₁ → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋)
  fill-cube-right sq₋₋₀ {p₋₀₁ = p₋₀₁} {p₋₁₁ = p₋₁₁} ids sq₋₀₋ sq₋₁₋ ids =
    (_ ,
     cube-shift-left (vert-degen-square-β sq₋₋₀)
       (cube-shift-top (horiz-degen-square-β sq₋₀₋)
         (cube-shift-bot (horiz-degen-square-β sq₋₁₋)
           cu)))
    where
    fill-sq : Σ (p₋₀₁ == p₋₁₁) (λ α₋₋₁ →
      Square (vert-degen-path sq₋₋₀) (horiz-degen-path sq₋₀₋)
             (horiz-degen-path sq₋₁₋) α₋₋₁)
    fill-sq = fill-square-right _ _ _

    cu : Cube (vert-degen-square (vert-degen-path sq₋₋₀))
              (vert-degen-square (fst fill-sq)) ids
              (horiz-degen-square (horiz-degen-path sq₋₀₋))
              (horiz-degen-square (horiz-degen-path sq₋₁₋)) ids
    cu = y-id-cube-in (snd fill-sq)

fill-cube-left-unique : ∀ {i} {A : Type i} {a₀₀₀ : A}
  {a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  {sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁} -- back
  {sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁} -- top
  {sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁} -- bottom
  {sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁} -- front
  → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  → sq₋₋₀ == fst (fill-cube-left sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋)
fill-cube-left-unique idc = idp

fill-cube-right-unique : ∀ {i} {A : Type i} {a₀₀₀ : A}
  {a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  {sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁} -- back
  {sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁} -- top
  {sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁} -- bottom
  {sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁} -- front
  → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  → sq₋₋₁ == fst (fill-cube-right sq₋₋₀ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋)
fill-cube-right-unique idc = idp

{- Paths as degenerate cubes -}
module _ {i} {A : Type i} where

  x-degen-cube : {a₀₀ a₀₁ a₁₀ a₁₁ : A}
    {p₀₋ : a₀₀ == a₀₁} {p₋₀ : a₀₀ == a₁₀}
    {p₋₁ : a₀₁ == a₁₁} {p₁₋ : a₁₀ == a₁₁}
    {sq₋₋₀ sq₋₋₁ : Square p₀₋ p₋₀ p₋₁ p₁₋}
    → sq₋₋₀ == sq₋₋₁
    → Cube sq₋₋₀ sq₋₋₁ hid-square hid-square hid-square hid-square
  x-degen-cube {sq₋₋₀ = ids} idp = idc

  y-degen-cube : {a₀₀ a₀₁ a₁₀ a₁₁ : A}
    {p₀₋ : a₀₀ == a₀₁} {p₋₀ : a₀₀ == a₁₀}
    {p₋₁ : a₀₁ == a₁₁} {p₁₋ : a₁₀ == a₁₁}
    {sq₀₋₋ sq₁₋₋ : Square p₀₋ p₋₀ p₋₁ p₁₋}
    → sq₀₋₋ == sq₁₋₋
    → Cube hid-square hid-square sq₀₋₋ vid-square vid-square sq₁₋₋
  y-degen-cube {sq₀₋₋ = ids} idp = idc

  z-degen-cube : {a₀₀ a₀₁ a₁₀ a₁₁ : A}
    {p₀₋ : a₀₀ == a₀₁} {p₋₀ : a₀₀ == a₁₀}
    {p₋₁ : a₀₁ == a₁₁} {p₁₋ : a₁₀ == a₁₁}
    {sq₋₀₋ sq₋₁₋ : Square p₀₋ p₋₀ p₋₁ p₁₋}
    → sq₋₀₋ == sq₋₁₋
    → Cube vid-square vid-square vid-square sq₋₀₋ sq₋₁₋ vid-square
  z-degen-cube {sq₋₀₋ = ids} idp = idc

  x-degen-cube-out : {a₀₀ a₀₁ a₁₀ a₁₁ : A}
    {p₀₋ : a₀₀ == a₀₁} {p₋₀ : a₀₀ == a₁₀}
    {p₋₁ : a₀₁ == a₁₁} {p₁₋ : a₁₀ == a₁₁}
    {sq₋₋₀ sq₋₋₁ : Square p₀₋ p₋₀ p₋₁ p₁₋}
    → Cube sq₋₋₀ sq₋₋₁ hid-square hid-square hid-square hid-square
    → sq₋₋₀ == sq₋₋₁
  x-degen-cube-out cu =
    fill-cube-left-unique cu ∙ ! (fill-cube-left-unique (x-degen-cube idp))

{- A pathover between squares can be represented as a cube -}
module _ {i j} {A : Type i} {B : Type j} {b₀₀ b₀₁ b₁₀ b₁₁ : A → B}
  {p₀₋ : (a : A) → b₀₀ a == b₀₁ a} {p₋₀ : (a : A) → b₀₀ a == b₁₀ a}
  {p₋₁ : (a : A) → b₀₁ a == b₁₁ a} {p₁₋ : (a : A) → b₁₀ a == b₁₁ a}
  where

  ↓-square-to-cube :  {x y : A} {q : x == y}
    {u : Square (p₀₋ x) (p₋₀ x) (p₋₁ x) (p₁₋ x)}
    {v : Square (p₀₋ y) (p₋₀ y) (p₋₁ y) (p₁₋ y)}
    → u == v [ (λ z → Square (p₀₋ z) (p₋₀ z) (p₋₁ z) (p₁₋ z)) ↓ q ]
    → Cube u v (natural-square p₀₋ q ) (natural-square p₋₀ q)
           (natural-square p₋₁ q) (natural-square p₁₋ q)
  ↓-square-to-cube {q = idp} r = x-degen-cube r

  cube-to-↓-square : {x y : A} {q : x == y}
    {sqx : Square (p₀₋ x) (p₋₀ x) (p₋₁ x) (p₁₋ x)}
    {sqy : Square (p₀₋ y) (p₋₀ y) (p₋₁ y) (p₁₋ y)}
    → Cube sqx sqy (natural-square p₀₋ q) (natural-square p₋₀ q)
           (natural-square p₋₁ q) (natural-square p₁₋ q)
    → sqx == sqy [ (λ z → Square (p₀₋ z) (p₋₀ z) (p₋₁ z) (p₁₋ z)) ↓ q ]
  cube-to-↓-square {q = idp} cu = x-degen-cube-out cu

module _ {i j} {A : Type i} {B : Type j} {b₀₀ b₀₁ b₁₀ b₁₁ : B}
  {p₀₋ : (a : A) → b₀₀ == b₀₁} {p₋₀ : (a : A) → b₀₀ == b₁₀}
  {p₋₁ : (a : A) → b₀₁ == b₁₁} {p₁₋ : (a : A) → b₁₀ == b₁₁}
  where

  cube-to-disc-square : {x y : A} {q : x == y}
    {sqx : Square (p₀₋ x) (p₋₀ x) (p₋₁ x) (p₁₋ x)}
    {sqy : Square (p₀₋ y) (p₋₀ y) (p₋₁ y) (p₁₋ y)}
    → Cube sqx sqy (natural-square p₀₋ q) (natural-square p₋₀ q)
           (natural-square p₋₁ q) (natural-square p₁₋ q)
    → Square (square-to-disc sqx) (ap (λ z → p₀₋ z ∙ p₋₁ z) q)
             (ap (λ z → p₋₀ z ∙ p₁₋ z) q) (square-to-disc sqy)
  cube-to-disc-square cu =
    ↓-='-to-square (ap↓ square-to-disc (cube-to-↓-square cu))

ap-cube : ∀ {i j} {A : Type i} {B : Type j} (f : A → B)
  {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  {sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁} -- back
  {sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁} -- top
  {sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁} -- bottom
  {sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁} -- front
  → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  → Cube (ap-square f sq₋₋₀) (ap-square f sq₋₋₁) (ap-square f sq₀₋₋)
         (ap-square f sq₋₀₋) (ap-square f sq₋₁₋) (ap-square f sq₁₋₋)
ap-cube f idc = idc

natural-cube : ∀ {i j} {A : Type i} {B : Type j}
  {f₀₀ f₀₁ f₁₀ f₁₁ : A → B}
  {p₀₋ : (a : A) → f₀₀ a == f₀₁ a} {p₋₀ : (a : A) → f₀₀ a == f₁₀ a}
  {p₋₁ : (a : A) → f₀₁ a == f₁₁ a} {p₁₋ : (a : A) → f₁₀ a == f₁₁ a}
  (sq : ∀ a → Square (p₀₋ a) (p₋₀ a) (p₋₁ a) (p₁₋ a))
  {x y : A} (q : x == y)
  → Cube (sq x) (sq y)
         (natural-square p₀₋ q) (natural-square p₋₀ q)
         (natural-square p₋₁ q) (natural-square p₁₋ q)
natural-cube sq idp = x-degen-cube idp

cube-rotate-x→z : ∀ {i} {A : Type i}
  {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  {sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁} -- back
  {sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁} -- top
  {sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁} -- bottom
  {sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁} -- front
  → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  → Cube (square-symmetry sq₀₋₋) (square-symmetry sq₁₋₋)
         (square-symmetry sq₋₀₋) sq₋₋₀ sq₋₋₁ (square-symmetry sq₋₁₋)
cube-rotate-x→z idc = idc

cube-symmetry-x : ∀ {i} {A : Type i}
  {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  {sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁} -- back
  {sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁} -- top
  {sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁} -- bottom
  {sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁} -- front
  → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  → Cube (square-symmetry sq₋₋₀) (square-symmetry sq₋₋₁)
         sq₋₀₋ sq₀₋₋ sq₁₋₋ sq₋₁₋
cube-symmetry-x idc = idc

cube-!-x : ∀ {i} {A : Type i}
  {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- right

  {p₀₀₋ : a₀₀₀ == a₀₀₁} {p₀₁₋ : a₀₁₀ == a₀₁₁}
  {p₁₀₋ : a₁₀₀ == a₁₀₁} {p₁₁₋ : a₁₁₀ == a₁₁₁}
  {sq₀₋₋ : Square p₀₋₀ p₀₀₋ p₀₁₋ p₀₋₁} -- back
  {sq₋₀₋ : Square p₋₀₀ p₀₀₋ p₁₀₋ p₋₀₁} -- top
  {sq₋₁₋ : Square p₋₁₀ p₀₁₋ p₁₁₋ p₋₁₁} -- bottom
  {sq₁₋₋ : Square p₁₋₀ p₁₀₋ p₁₁₋ p₁₋₁} -- front
  → Cube sq₋₋₀ sq₋₋₁ sq₀₋₋ sq₋₀₋ sq₋₁₋ sq₁₋₋
  → Cube sq₋₋₁ sq₋₋₀ (!□h sq₀₋₋) (!□h sq₋₀₋) (!□h sq₋₁₋) (!□h sq₁₋₋)
cube-!-x idc = idc

_∙³x_ : ∀ {i} {A : Type i}
  {a₀₀₀ a₀₁₀ a₁₀₀ a₁₁₀ a₀₀₁ a₀₁₁ a₁₀₁ a₁₁₁ a₀₀₂ a₀₁₂ a₁₀₂ a₁₁₂ : A}
  {p₀₋₀ : a₀₀₀ == a₀₁₀} {p₋₀₀ : a₀₀₀ == a₁₀₀}
  {p₋₁₀ : a₀₁₀ == a₁₁₀} {p₁₋₀ : a₁₀₀ == a₁₁₀}
  {sq₋₋₀ : Square p₀₋₀ p₋₀₀ p₋₁₀ p₁₋₀} -- left

  {p₀₋₁ : a₀₀₁ == a₀₁₁} {p₋₀₁ : a₀₀₁ == a₁₀₁}
  {p₋₁₁ : a₀₁₁ == a₁₁₁} {p₁₋₁ : a₁₀₁ == a₁₁₁}
  {sq₋₋₁ : Square p₀₋₁ p₋₀₁ p₋₁₁ p₁₋₁} -- middle

  {p₀₋₂ : a₀₀₂ == a₀₁₂} {p₋₀₂ : a₀₀₂ == a₁₀₂}
  {p₋₁₂ : a₀₁₂ == a₁₁₂} {p₁₋₂ : a₁₀₂ == a₁₁₂}
  {sq₋₋₂ : Square p₀₋₂ p₋₀₂ p₋₁₂ p₁₋₂} -- right

  {p₀₀l : a₀₀₀ == a₀₀₁} {p₀₁l : a₀₁₀ == a₀₁₁}
  {p₁₀l : a₁₀₀ == a₁₀₁} {p₁₁l : a₁₁₀ == a₁₁₁}
  {sq₀₋l : Square p₀₋₀ p₀₀l p₀₁l p₀₋₁} -- backl
  {sq₋₀l : Square p₋₀₀ p₀₀l p₁₀l p₋₀₁} -- topl
  {sq₋₁l : Square p₋₁₀ p₀₁l p₁₁l p₋₁₁} -- bottoml
  {sq₁₋l : Square p₁₋₀ p₁₀l p₁₁l p₁₋₁} -- frontl

  {p₀₀r : a₀₀₁ == a₀₀₂} {p₀₁r : a₀₁₁ == a₀₁₂}
  {p₁₀r : a₁₀₁ == a₁₀₂} {p₁₁r : a₁₁₁ == a₁₁₂}
  {sq₀₋r : Square p₀₋₁ p₀₀r p₀₁r p₀₋₂} -- backr
  {sq₋₀r : Square p₋₀₁ p₀₀r p₁₀r p₋₀₂} -- topr
  {sq₋₁r : Square p₋₁₁ p₀₁r p₁₁r p₋₁₂} -- bottomr
  {sq₁₋r : Square p₁₋₁ p₁₀r p₁₁r p₁₋₂} -- frontr

  → Cube sq₋₋₀ sq₋₋₁ sq₀₋l sq₋₀l sq₋₁l sq₁₋l
  → Cube sq₋₋₁ sq₋₋₂ sq₀₋r sq₋₀r sq₋₁r sq₁₋r
  → Cube sq₋₋₀ sq₋₋₂ (sq₀₋l ⊡h sq₀₋r) (sq₋₀l ⊡h sq₋₀r)
         (sq₋₁l ⊡h sq₋₁r) (sq₁₋l ⊡h sq₁₋r)
idc ∙³x cu = cu

infixr 8 _∙³x_


{-# OPTIONS --experimental-irrelevance #-}

open import Agda.Builtin.Bool
open import Agda.Builtin.Equality

data Box (A : Set) : ..(x : A) → Set where
  c : (x : A) → Box A x

unbox : {A : Set} → .(x : A) → Box A x → A
unbox a (c b) = b

.b : Bool
b = true

b' : Bool
b' = unbox b (c _)


--{-# OPTIONS --with-K #-}

open import Data
open import Data.Tuple using (_⨯_ ; _,_)
open import Logic.Predicate
import      Lvl
open import Syntax.Number
import      Type as Meta

-- `Constants` is the type of all possible constant terms.
-- `Sort` is a subset of `Constants` that indicate the sorts of the type system (the types of types).
-- `Axioms` pairs constant terms with types.
-- `Rules` pairs product terms with types.
module Formalization.PureTypeSystem (Constants : Meta.Type{0}) where -- TODO: I don't really have a reference for any of the definitions so they may be incorrect

open import Numeral.Natural
open import Numeral.Finite

private variable ℓ ℓ₁ ℓ₂ ℓ₃ : Lvl.Level
private variable d d₁ d₂ d₃ : ℕ

data Term : ℕ → Meta.Type{0} where
  Apply    : Term(d) → Term(d) → Term(d)
  Abstract : Term(d) → Term(𝐒(d)) → Term(d)
  Var      : 𝕟(d) → Term(d)
  Constant : Constants → Term(d)
  Product  : Term(d) → Term(𝐒(d)) → Term(d)

Expression : Meta.Type{0}
Expression = Term(0)

module VarNumeralSyntax where
  -- Syntax for writing Var as a numeral.
  instance
    Term-from-ℕ : ∀{N} → Numeral(Term(N))
    Numeral.restriction-ℓ ( Term-from-ℕ {N} ) = Numeral.restriction-ℓ ( 𝕟-from-ℕ {N} )
    Numeral.restriction   ( Term-from-ℕ {N} ) = Numeral.restriction ( 𝕟-from-ℕ {N} )
    num                   ⦃ Term-from-ℕ {N} ⦄ (n) ⦃ proof ⦄ = Var(num n)

module ExplicitLambdaSyntax where
  open VarNumeralSyntax public

  infixr 100 𝜆[_::_] Π[_::_]
  infixl 101 _←_

  pattern 𝜆[_::_] d type expr = Term.Abstract{d} type expr
  pattern Π[_::_] d type expr = Term.Product{d} type expr
  pattern _←_ a b  = Term.Apply a b

module _ where
  var-𝐒 : Term(d) → Term(𝐒(d))
  var-𝐒 (Apply f x)             = Apply (var-𝐒(f)) (var-𝐒(x))
  var-𝐒 (Abstract{d} type body) = Abstract{𝐒(d)} (var-𝐒 type) (var-𝐒(body))
  var-𝐒 (Var{𝐒(d)} n)           = Var{𝐒(𝐒(d))} (𝐒(n))
  var-𝐒 (Constant c)            = Constant c
  var-𝐒 (Product a b)           = Product (var-𝐒 a) (var-𝐒 b)

  substituteVar0 : Term(d) → Term(𝐒(d)) → Term(d)
  substituteVar0 val (Apply f x)          = Apply (substituteVar0 val f) (substituteVar0 val x)
  substituteVar0 val (Abstract type body) = Abstract (substituteVar0 val type) (substituteVar0 (var-𝐒 val) body)
  substituteVar0 val (Var 𝟎)              = val
  substituteVar0 val (Var(𝐒 i))           = Var i
  substituteVar0 val (Constant c)         = Constant c
  substituteVar0 val (Product a b)        = Product (substituteVar0 val a) (substituteVar0 (var-𝐒 val) b)

  open import Relator.Equals

  private variable x y : Term(d)

  substituteVar0-var-𝐒 : (substituteVar0 y (var-𝐒 x) ≡ x)
  substituteVar0-var-𝐒 {d}{y}{Apply f x}
    rewrite substituteVar0-var-𝐒 {d}{y}{f}
    rewrite substituteVar0-var-𝐒 {d}{y}{x}
    = [≡]-intro
  substituteVar0-var-𝐒 {d}{y}{Abstract t x}
    rewrite substituteVar0-var-𝐒 {d}{y}{t}
    rewrite substituteVar0-var-𝐒 {𝐒 d}{var-𝐒 y}{x}
    = [≡]-intro
  substituteVar0-var-𝐒 {_}{_}{Var 𝟎}      = [≡]-intro
  substituteVar0-var-𝐒 {_}{_}{Var(𝐒 _)}   = [≡]-intro
  substituteVar0-var-𝐒 {_}{_}{Constant c} = [≡]-intro
  substituteVar0-var-𝐒 {d}{y}{Product t x}
    rewrite substituteVar0-var-𝐒 {d}{y}{t}
    rewrite substituteVar0-var-𝐒 {𝐒 d}{var-𝐒 y}{x}
    = [≡]-intro
  {-# REWRITE substituteVar0-var-𝐒 #-}

module _ where
  -- postulate _β⥈*_ : Term(d) → Term(d) → Meta.Type{0}
  open import Relator.ReflexiveTransitiveClosure

  private variable f g x y : Term(d)

  -- β-reduction (beta) with its compatible closure over `Apply`.
  -- Reduces a term of form `f(x)` to `f[0 ≔ x]`.
  data _β⇴_ : Term(d₁) → Term(d₂) → Meta.Type{1} where
    β : ∀{f : Term(𝐒(d))}{x ty : Term(d)} → (Apply(Abstract ty (f))(x) β⇴ substituteVar0(x)(f))
    cong-applyₗ : (f β⇴ g) → (Apply f(x) β⇴ Apply g(x))
    cong-applyᵣ : (x β⇴ y) → (Apply f(x) β⇴ Apply f(y))

  _β⇴*_ : Term(d) → Term(d) → Meta.Type
  _β⇴*_ = ReflexiveTransitiveClosure(_β⇴_)

  _β⥈_ : Term(d) → Term(d) → Meta.Type
  _β⥈_ = SymmetricClosure(_β⇴_)

  _β⥈*_ : Term(d) → Term(d) → Meta.Type
  _β⥈*_ = ReflexiveTransitiveClosure(_β⥈_)

{-
module _ where
  open import Data.Boolean
  open import Data.Boolean.Stmt
  open import Data.Option
  import      Data.Option.Functions as Option
  open import Logic.Propositional
  open import Functional

  private variable T A B : Meta.Type{ℓ}
  private variable x : A
  private variable y : B
  private variable m m₁ m₂ : T
  private variable f : A → B

  open import Relator.Equals
  record MapContainer (A : Meta.Type{ℓ₁}) (B : A → Meta.Type{ℓ₂}) (Map : Meta.Type{ℓ₃}) : Meta.Type{Lvl.𝐒(ℓ₁) Lvl.⊔ Lvl.𝐒(ℓ₂) Lvl.⊔ ℓ₃} where
    field
      ∅     : Map
      has   : A → Map → Bool
      get   : (a : A) → Map → Option(B(a))
      set   : (a : A) → B(a) → Map → Map
      unset : A → Map → Map
      union : Map → Map → Map
      -- map   : (B → B) → (Map → Map)
      _⊆_   : Map → Map → Meta.Type{0}
      _≡ₘ_  : Map → Map → Meta.Type{0}

    field
      get-of-∅     : (get x ∅ ≡ None)
      get-has      : (Option.isSome(get x m) ≡ has x m)
      get-of-set   : (get x (set x y m) ≡ Some(y))
      get-of-unset : (get x (unset x m) ≡ None)
      get-of-union : (get x (union m₁ m₂) ≡ (get x m₁) Option.Same.orᵣ (get x m₂))
      -- get-of-map   : (get x (map f m) ≡ Option.map f(get x m))
      submap-get   : (m₁ ⊆ m₂) ↔ (∀{x} → (IsFalse(has x m₁) ∨ (get x m₁ ≡ get x m₂)))
      equiv-get    : (m₁ ≡ₘ m₂) ↔ (∀{x} → (get x m₁ ≡ get x m₂))
-}

open import Numeral.CoordinateVector
open import Type.Dependent
module Typing
  (Sort : ∀{d} → Term(d) → Meta.Type{0})
  (Axioms : Constants → Expression → Meta.Type{0})
  (Rules : ∀{d₁ d₂ d₃} → ∃(Sort{d₁}) → ∃(Sort{d₂}) → ∃(Sort{d₃}) → Meta.Type{0})
  where

  data Context : ℕ → Meta.Type{0} where
    ∅   : Context(𝟎)
    _⊱_ : Context(d) → Term(d) → Context(𝐒(d))

  get : (i : 𝕟(𝐒(d))) → Context(𝐒(d)) → Term(d)
  get       𝟎     (_ ⊱ x) = x
  get {𝐒 _} (𝐒 i) (l ⊱ _) = var-𝐒(get i l)

  private variable A A₁ A₂ B B₁ B₂ F F₁ F₂ X X₁ X₂ BX T T₁ T₂ : Term(d)
  private variable c : Constants
  private variable i i₁ i₂ : 𝕟(d)
  private variable s s₁ s₂ s₃ : ∃(Sort)
  private variable Γ Δ : Context(d)

  -- Subtyping rules.
  _<:_ = _β⥈*_

  open import Data.Option
  open import Relator.Equals

  -- Typing rules. (TODO: I think there are some issues with the depth indexing)
  data _⊢_::_ : Context(d₁) → Term(d₂) → Term(d₃) → Meta.Type{1} where
    constants   : (Axioms c A) → (Γ ⊢ (Constant{d₂} c) :: A)
    variables   : (Γ ⊢ (get i Γ) :: ([∃]-witness s)) → (Γ ⊢ (Var i) :: (get i Γ))
    weakening   : (Γ ⊢ B :: ([∃]-witness s)) → (Γ ⊢ X :: A) → ((Γ ⊱ B) ⊢ X :: A)
    product     : (Rules s₁ s₂ s₃) → (Γ ⊢ A :: ([∃]-witness s₁)) → ((Γ ⊱ A) ⊢ B :: ([∃]-witness s₂)) → (Γ ⊢ (Product A B) :: ([∃]-witness s₃))
    application : (Γ ⊢ F :: Product A B) → (Γ ⊢ X :: A) → (Γ ⊢ Apply F X :: substituteVar0 X B)
    abstraction : (Γ ⊢ (Product A B) :: ([∃]-witness s)) → ((Γ ⊱ A) ⊢ F :: B) → (Γ ⊢ (Abstract A F) :: (Product A B))
    -- conversion  : (Γ ⊢ B :: Constant([∃]-witness s)) → (A <: B) → (Γ ⊢ X :: A) → (Γ ⊢ X :: B)

{-
3: 6
4: 7

0: 3
1: 4

𝕟-to-ℕ (Wrapping.[−] i₁) ≡ 𝕟-to-ℕ (Wrapping.[−] i₂)
-}
  data _≡d_ : Term(d₁) → Term(d₂) → Meta.Type{0} where
    application : (F₁ ≡d F₂) → (X₁ ≡d X₂) → (Apply F₁ X₁ ≡d Apply F₂ X₂)
    abstraction : (T₁ ≡d T₂) → (B₁ ≡d B₂) → Abstract T₁ B₁ ≡d Abstract T₂ B₂
    var-left    : (Var{𝐒(d₁)} {!d₁ −₀ d₂!} ≡d Var{𝐒(d₂)} 𝟎)
    var-right   : (Var{𝐒(d₁)} 𝟎 ≡d Var{𝐒(d₂)} {!d₁ −₀ d₂!})
    var-step    : (Var i₁ ≡d Var i₂) → (Var(𝐒(i₁)) ≡d Var(𝐒(i₂)))
    constant    : Constant{d₁} c ≡d Constant{d₂} c
    product     : (A₁ ≡d A₂) → (B₁ ≡d B₂) → Product A₁ B₁ ≡d Product A₂ B₂

  open import Logic.Propositional
  open import Syntax.Function
  open import Type.Dependent.Functions

  -- typing-substitution : ((set Var0 B (Γ ∪ Δ)) ⊢ A :: B) → ((Γ ∪ map(\(intro e p) → {!substituteVar0 X p!}) Δ) ⊢ (substituteVar0 X A) :: (substituteVar0 X B))

  import      Data.Either as Either
  open import Logic.Classical
  module _
    ⦃ classical-sort : ∀{d}{c} → Classical(Sort{d} c) ⦄
    -- (axioms-term-or-sort : ∀{A B} → (Axioms A B) → (Sort(B) ∨ ∃(d ↦ ∃{Obj = ∃(Sort{d})}(s ↦ Γ ⊢ B :: ([∃]-witness s)))))
    where

    sort-substituteVar0 : Sort(X) → Sort(A) → Sort(substituteVar0 X A)
    sort-substituteVar0 {A = Apply F X}    _      sort-A = {!!}
    sort-substituteVar0 {A = Abstract T B} _      sort-A = {!!}
    sort-substituteVar0 {A = Var 𝟎}        sort-X sort-A = sort-X
    sort-substituteVar0 {A = Var (𝐒 i)}    _      sort-A = {!!}
    sort-substituteVar0 {A = Constant c}   _      sort-A = {!sort-A!}
    sort-substituteVar0 {A = Product A B}  _      sort-A = {!!}

    -- When a term has a type, the type is either a sort or its type is a sort.
    type-is-term-or-sort : (Γ ⊢ A :: B) → (Sort(B) ∨ ∃{Obj = ∃(d ↦ ∃(Sort{d}))}(s ↦ Γ ⊢ B :: ([∃]-witness([∃]-proof s))))
    type-is-term-or-sort (constants {c} axiom) = {!!}
    type-is-term-or-sort (variables {s = s} ty) = [∨]-introᵣ ([∃]-intro ([∃]-intro _ ⦃ s ⦄) ⦃ ty ⦄)
    type-is-term-or-sort (weakening{s = s} pre post) = Either.mapRight ([∃]-map-proof (weakening{s = s} pre)) (type-is-term-or-sort post)
    type-is-term-or-sort (product{s₃ = s₃} r a b) = [∨]-introₗ ([∃]-proof s₃)
    type-is-term-or-sort (application {F = F} ab a) = {!!}
    type-is-term-or-sort (abstraction{s = s} ab f) = [∨]-introᵣ ([∃]-intro ([∃]-intro _ ⦃ s ⦄) ⦃ ab ⦄)
    {-type-is-term-or-sort (constants {c} axiom) = ? -- axioms-term-or-sort axiom
    type-is-term-or-sort (variables {s = s} ty) = [∨]-introᵣ {!!}
    type-is-term-or-sort (product{s₃ = s₃} r a b) = [∨]-introₗ ([∃]-proof s₃)
    type-is-term-or-sort (application {F = Apply F F₁} ab a) = {!!}
    type-is-term-or-sort (application {F = Abstract F F₁} (abstraction ab ab₁) a) = {!!}
    type-is-term-or-sort (application {F = Constant x} ab a) = {!!}
    type-is-term-or-sort (application {F = Product F F₁} ab a) = {!!}
    type-is-term-or-sort (abstraction{s = s} ab f) = [∨]-introᵣ ([∃]-intro s ⦃ ab ⦄)
    -}

  -- A supermap of the context have the same typings.
  -- typing-supercontext : (Γ ⊆ Δ) → ((Γ ⊢ A :: B) → (Δ ⊢ A :: B))

  -- TODO: Confluence, subject reduction

  open import Data.Option.Equiv.Id
  open import Data.Option.Proofs
  open import Relator.Equals.Proofs
  open import Structure.Function
  open import Structure.Function.Domain hiding (Constant)
  open import Structure.Relator.Properties
  open import Structure.Setoid.Uniqueness
  open import Syntax.Transitivity

  instance
    Constant-injective : Injective(Constant{d})
    Injective.proof Constant-injective [≡]-intro = [≡]-intro

  instance
    Var-injective : Injective(Var{d})
    Injective.proof Var-injective [≡]-intro = [≡]-intro

  Productₗ-injective : ∀{ty₁ ty₂}{f₁ f₂} → (Product{d} ty₁ f₁ ≡ Product{d} ty₂ f₂) → (ty₁ ≡ ty₂)
  Productₗ-injective [≡]-intro = [≡]-intro

  Productᵣ-injective : ∀{ty₁ ty₂}{f₁ f₂} → (Product{d} ty₁ f₁ ≡ Product{d} ty₂ f₂) → (f₁ ≡ f₂) -- TODO: Here is an example of what axiom K does. If one had `Product ty f₁ ≡ Product ty f₂` instead, then it cannot pattern match on the identity because of `ty` being the same on both sides.
  Productᵣ-injective [≡]-intro = [≡]-intro

  Applyₗ-injective : ∀{f₁ f₂}{x₁ x₂} → (Apply{d} f₁ x₁ ≡ Apply{d} f₂ x₂) → (f₁ ≡ f₂)
  Applyₗ-injective [≡]-intro = [≡]-intro

  Applyᵣ-injective : ∀{f₁ f₂}{x₁ x₂} → (Apply{d} f₁ x₁ ≡ Apply{d} f₂ x₂) → (x₁ ≡ x₂)
  Applyᵣ-injective [≡]-intro = [≡]-intro

  Abstractₗ-injective : ∀{T₁ T₂}{body₁ body₂} → (Abstract{d} T₁ body₁ ≡ Abstract{d} T₂ body₂) → (T₁ ≡ T₂)
  Abstractₗ-injective [≡]-intro = [≡]-intro

  Abstractᵣ-injective : ∀{T₁ T₂}{body₁ body₂} → (Abstract{d} T₁ body₁ ≡ Abstract{d} T₂ body₂) → (body₁ ≡ body₂)
  Abstractᵣ-injective [≡]-intro = [≡]-intro

  open import Functional
  open import Logic.Predicate.Equiv
  import      Structure.Relator.Function.Multi as Relator
  open import Structure.Operator

  -- Every typable term have an unique type when all constants and products also have an unique type.
  {-typing-uniqueness : Relator.Names.Function(1)(Axioms) → (∀{d₁ d₂ d₃ : ℕ} → Relator.Names.Function(2) ⦃ [≡∃]-equiv ⦄ ⦃ [≡∃]-equiv ⦄ ⦃ [≡∃]-equiv ⦄ (Rules{d₁}{d₂}{d₃})) → Unique(Γ ⊢ X ::_)
  typing-uniqueness ax rul (constants px)       (constants py)       = ax [≡]-intro px py
  typing-uniqueness ax rul (variables _ pix)    (variables _ piy)    = injective(Some) (transitivity(_≡_) (symmetry(_≡_) pix) piy)
  typing-uniqueness ax rul (product rx px px₁)  (product ry py py₁)
    rewrite typing-uniqueness ax rul px py
    = rul (typing-uniqueness ax rul px py) (typing-uniqueness ax rul px₁ py₁) rx ry
  typing-uniqueness ax rul (application px px₁) (application py py₁) = congruence₁(substituteVar0 _) (Productᵣ-injective (typing-uniqueness ax rul px py))
  typing-uniqueness ax rul (abstraction px px₁) (abstraction py py₁)

    = congruence₁(Product _) {!!}  -- (typing-uniqueness ax rul px₁ {!!})
  -- typing-uniqueness {𝐒 d} ax rul {x}{y} px (conversion py x₁ py₁) rewrite typing-uniqueness ax rul px py₁ = {!x!}
  -- typing-uniqueness {𝐒 d} ax rul (conversion px x px₁) py = {!!}
  -}

  {-
  typing-uniqueness : Relator.Names.Function(1)(Axioms) → (∀{d₁ d₂ d₃ : ℕ} → Relator.Names.Function(2) ⦃ [≡∃]-equiv ⦄ ⦃ [≡∃]-equiv ⦄ ⦃ [≡∃]-equiv ⦄ (Rules{d₁}{d₂}{d₃})) → (∀{d : ℕ} → Relator.Names.Function(2)(_⊢_::_ {d = d}))
  typing-uniqueness ax rul                  gam exp           (constants px)       (constants py)       = ax (injective(Constant) exp) px py
  typing-uniqueness ax rul {x = Γ₁}{y = Γ₂} gam exp {y₁} {y₂} (variables _ pix)    (variables _ piy)    = injective(Some) $
    Some y₁  🝖[ _≡_ ]-[ pix ]-sym
    get _ Γ₁ 🝖[ _≡_ ]-[ congruence₂(get) (injective(Var) exp) gam ]
    get _ Γ₂ 🝖[ _≡_ ]-[ piy ]
    Some y₂ 🝖-end
  typing-uniqueness ax rul gam exp (product rx px px₁)  (product ry py py₁)  = rul XY AB rx ry where
    XY = typing-uniqueness ax rul gam (Productₗ-injective exp) px py
    AB = typing-uniqueness ax rul (congruence₃(push) (Productₗ-injective exp) XY gam) (Productᵣ-injective exp) px₁ py₁
  typing-uniqueness ax rul gam exp (application px px₁) (application py py₁) = congruence₂(substituteVar0) (Applyᵣ-injective exp) (Productᵣ-injective (typing-uniqueness ax rul gam (Applyₗ-injective exp) px py))
  typing-uniqueness ax rul gam exp (abstraction px px₁) (abstraction py py₁) = congruence₂(Product) {!!} {!!} where
    X₁X₂ = Abstractₗ-injective exp
    AB : _
    Y₁Y₂ : _
    Y₁Y₂ = typing-uniqueness ax rul (congruence₃(push) X₁X₂ AB gam) (Abstractᵣ-injective exp) px₁ py₁
    AB = typing-uniqueness ax rul gam (congruence₂(Product) X₁X₂ Y₁Y₂) px py
  -- congruence₂(Product) (Abstractₗ-injective exp) (typing-uniqueness ax rul (congruence₃(push) (Abstractₗ-injective exp) (typing-uniqueness ax rul gam {!!} px py) gam) (Abstractᵣ-injective exp) px₁ py₁)
  -}


open import Agda.Builtin.Nat
open import Agda.Builtin.FromNat
open import Agda.Builtin.Unit

instance
  NumberNat : Number Nat
  Number.Constraint NumberNat _ = ⊤
  fromNat {{NumberNat}} n = n

open import Issue2641.Import


module Issue858 where

module _ (A B : Set) (recompute : .B → .{{A}} → B) where

  _$_ : .(A → B) → .A → B
  f $ x with .{f} | .(f x) | .{{x}}
  ... | y = recompute y

module _ (A B : Set) (recompute : ..B → ..{{A}} → B) where

  _$'_ : ..(A → B) → ..A → B
  f $' x with ..{f} | ..(f x) | ..{{x}}
  ... | y = recompute y


{-# OPTIONS --without-K --safe --no-sized-types --no-guardedness
            --no-subtyping #-}

module Agda.Builtin.String.Properties where

open import Agda.Builtin.String
open import Agda.Builtin.Equality

primitive

  primStringToListInjective : ∀ a b → primStringToList a ≡ primStringToList b → a ≡ b


------------------------------------------------------------------------
-- The Agda standard library
--
-- List Literals
------------------------------------------------------------------------

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

module Data.List.Literals where

open import Agda.Builtin.FromString
open import Data.Unit
open import Agda.Builtin.Char
open import Agda.Builtin.List
open import Data.String.Base using (toList)

isString : IsString (List Char)
isString = record
  { Constraint = λ _ → ⊤
  ; fromString = λ s → toList s
  }


{-# OPTIONS --safe #-}

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.Introductions.Sigma {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

open import Definition.Untyped as U hiding (wk)
open import Definition.Untyped.Properties
open import Definition.Typed
open import Definition.Typed.Weakening using (_∷_⊆_ ; _•ₜ_)
open import Definition.Typed.Properties
open import Definition.LogicalRelation
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Weakening
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Substitution
open import Definition.LogicalRelation.Substitution.Weakening
open import Definition.LogicalRelation.Substitution.Properties
open import Definition.LogicalRelation.Substitution.MaybeEmbed
import Definition.LogicalRelation.Substitution.Irrelevance as S
open import Definition.LogicalRelation.Substitution.Introductions.Universe
open import Definition.LogicalRelation.Substitution.Introductions.Pi

open import Tools.Nat
open import Tools.Product
import Tools.PropositionalEquality as PE
open import Tools.Empty using (⊥; ⊥-elim)

-- Validity of ∃.
∃ᵛ : ∀ {F G Γ l∃ l}
     ([Γ] : ⊩ᵛ Γ)
     ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
   → Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ G ^ [ % , ι l∃ ] / [Γ] ∙ [F]
   → Γ ⊩ᵛ⟨ l ⟩ ∃ F ▹ G ^ [ % , ι l∃ ] / [Γ]
∃ᵛ {F} {G} {Γ} {l∃} {l} [Γ] [F] [G] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let [F]σ {σ′} [σ′] = [F] {σ = σ′} ⊢Δ [σ′]
      [σF] = proj₁ ([F]σ [σ])
      ⊢F {σ′} [σ′] = escape (proj₁ ([F]σ {σ′} [σ′]))
      ⊢F≡F = escapeEq [σF] (reflEq [σF])
      [G]σ {σ′} [σ′] = [G] {σ = liftSubst σ′} (⊢Δ ∙ ⊢F [σ′])
                           (liftSubstS {F = F} [Γ] ⊢Δ [F] [σ′])
      ⊢G {σ′} [σ′] = escape (proj₁ ([G]σ {σ′} [σ′]))
      ⊢G≡G = escapeEq (proj₁ ([G]σ [σ])) (reflEq (proj₁ ([G]σ [σ])))
      ⊢∃F▹G = ∃ⱼ un-univ (⊢F [σ]) ▹ un-univ (⊢G [σ])
  in ∃ᵣ′ (subst σ F) (subst (liftSubst σ) G) (idRed:*: (univ ⊢∃F▹G)) (⊢F [σ]) (⊢G [σ]) (≅-univ (≅ₜ-∃-cong (⊢F [σ]) (≅-un-univ ⊢F≡F) (≅-un-univ ⊢G≡G)))
         (λ ρ ⊢Δ₁ → wk ρ ⊢Δ₁ [σF]) (λ {ρ} {Δ₁} {a} [ρ] ⊢Δ₁ [a] →
            let [a]′ = irrelevanceTerm′
                         (wk-subst F) PE.refl PE.refl (wk [ρ] ⊢Δ₁ [σF])
                         (proj₁ ([F] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]))) [a]
            in  Gapp {F = F} {G = G} {σ = σ} [Γ] [F] [G] ⊢Δ [σ] a [ρ] ⊢Δ₁ [a]′)
         (λ {ρ} {Δ₁} {a} {b} [ρ] ⊢Δ₁ [a] [b] [a≡b] →
            let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                [a]′ = irrelevanceTerm′
                         (wk-subst F) PE.refl PE.refl (wk [ρ] ⊢Δ₁ [σF])
                         (proj₁ ([F] ⊢Δ₁ [ρσ])) [a]
                [b]′ = irrelevanceTerm′
                         (wk-subst F) PE.refl PE.refl (wk [ρ] ⊢Δ₁ [σF])
                         (proj₁ ([F] ⊢Δ₁ [ρσ])) [b]
                [a≡b]′ = irrelevanceEqTerm′
                           (wk-subst F) PE.refl PE.refl (wk [ρ] ⊢Δ₁ [σF])
                           (proj₁ ([F] ⊢Δ₁ [ρσ])) [a≡b]
            in  irrelevanceEq″
                  (PE.sym (singleSubstWkComp a σ G))
                  (PE.sym (singleSubstWkComp b σ G)) PE.refl PE.refl
                  (proj₁ (GappGen {F = F} {G = G} {σ = σ} [Γ] [F] [G] ⊢Δ [σ] a [ρ] ⊢Δ₁ [a]′))
                  (Gapp {F = F} {G = G} {σ = σ} [Γ] [F] [G] ⊢Δ [σ] a [ρ] ⊢Δ₁ [a]′)
                  (proj₂ (GappGen {F = F} {G = G} {σ = σ} [Γ] [F] [G] ⊢Δ [σ] a [ρ] ⊢Δ₁ [a]′)
                         ([ρσ] , [b]′)
                         (reflSubst [Γ] ⊢Δ₁ [ρσ] , [a≡b]′)))
     ,  λ {σ′} [σ′] [σ≡σ′] →
        let var0 = var (⊢Δ ∙ ⊢F [σ])
                       (PE.subst (λ x → 0 ∷ x ^ [ % , ι l∃ ] ∈ (Δ ∙ subst σ F ^ [ % , ι l∃ ]))
                                 (wk-subst F) here)
            [wk1σ] = wk1SubstS [Γ] ⊢Δ (⊢F [σ]) [σ]
            [wk1σ′] = wk1SubstS [Γ] ⊢Δ (⊢F [σ]) [σ′]
            [wk1σ≡wk1σ′] = wk1SubstSEq [Γ] ⊢Δ (⊢F [σ]) [σ] [σ≡σ′]
            [F][wk1σ] = proj₁ ([F] (⊢Δ ∙ ⊢F [σ]) [wk1σ])
            [F][wk1σ′] = proj₁ ([F] (⊢Δ ∙ ⊢F [σ]) [wk1σ′])
            var0′ = conv var0
                         (≅-eq (escapeEq [F][wk1σ]
                                             (proj₂ ([F] (⊢Δ ∙ ⊢F [σ]) [wk1σ])
                                                    [wk1σ′] [wk1σ≡wk1σ′])))
        in  ∃₌ _ _ (id (univ (∃ⱼ un-univ (⊢F [σ′]) ▹ un-univ (⊢G [σ′]))))
               (≅-univ (≅ₜ-∃-cong (⊢F [σ])
                                  (≅-un-univ (escapeEq (proj₁ ([F] ⊢Δ [σ]))
                                    (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′])))
                                  (≅-un-univ (escapeEq (proj₁ ([G]σ [σ])) (proj₂ ([G]σ [σ])
                                  ([wk1σ′] , neuTerm [F][wk1σ′] (var 0) var0′ (~-var var0′))
                                  ([wk1σ≡wk1σ′] , neuEqTerm [F][wk1σ]
                                  (var 0) (var 0) var0 var0 (~-var var0)))))))
               (λ ρ ⊢Δ₁ → wkEq ρ ⊢Δ₁ [σF] (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′]))
               (λ {ρ} {Δ₁} {a} [ρ] ⊢Δ₁ [a] →
                  let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                      [ρσ′] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ′]
                      [a]′ = irrelevanceTerm′ (wk-subst F) PE.refl PE.refl (wk [ρ] ⊢Δ₁ [σF])
                                 (proj₁ ([F] ⊢Δ₁ [ρσ])) [a]
                      [a]″ = convTerm₁ (proj₁ ([F] ⊢Δ₁ [ρσ]))
                                        (proj₁ ([F] ⊢Δ₁ [ρσ′]))
                                        (proj₂ ([F] ⊢Δ₁ [ρσ]) [ρσ′]
                                               (wkSubstSEq [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ] [σ≡σ′]))
                                        [a]′
                      [ρσa≡ρσ′a] = consSubstSEq {t = a} {A = F} [Γ] ⊢Δ₁
                                                (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])
                                                (wkSubstSEq [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ] [σ≡σ′])
                                                [F] [a]′
                  in  irrelevanceEq″ (PE.sym (singleSubstWkComp a σ G))
                                      (PE.sym (singleSubstWkComp a σ′ G)) PE.refl PE.refl
                                      (proj₁ (GappGen {F = F} {G = G} {σ = σ} [Γ] [F] [G] ⊢Δ [σ] a [ρ] ⊢Δ₁ [a]′))
                                      (Gapp {F = F} {G = G} {σ = σ} [Γ] [F] [G] ⊢Δ [σ] a [ρ] ⊢Δ₁ [a]′)
                                      (proj₂ (GappGen {F = F} {G = G} {σ = σ} [Γ] [F] [G] ⊢Δ [σ] a [ρ] ⊢Δ₁ [a]′)
                                             (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ′] , [a]″)
                                             [ρσa≡ρσ′a]))
-- Validity of ∃-congurence.
∃-congᵛ : ∀ {F G H E Γ l∃ l}
          ([Γ] : ⊩ᵛ Γ)
          ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
          ([G] : Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ G ^ [ % , ι l∃ ] / [Γ] ∙ [F])
          ([H] : Γ ⊩ᵛ⟨ l ⟩ H ^ [ % , ι l∃ ] / [Γ])
          ([E] : Γ ∙ H ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ E ^ [ % , ι l∃ ] / [Γ] ∙ [H])
          ([F≡H] : Γ ⊩ᵛ⟨ l ⟩ F ≡ H ^ [ % , ι l∃ ] / [Γ] / [F])
          ([G≡E] : Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ G ≡ E ^ [ % , ι l∃ ] / [Γ] ∙ [F] / [G])
        → Γ ⊩ᵛ⟨ l ⟩ ∃ F ▹ G ≡ ∃ H ▹ E ^ [ % , ι l∃ ] / [Γ] / ∃ᵛ {F} {G} [Γ] [F] [G]
∃-congᵛ {F} {G} {H} {E} [Γ] [F] [G] [H] [E] [F≡H] [G≡E] {σ = σ} ⊢Δ [σ] =
  let [∃FG] = ∃ᵛ {F} {G} [Γ] [F] [G]
      [σ∃FG] = proj₁ ([∃FG] ⊢Δ [σ])
      _ , ∃ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmb (∃-elim [σ∃FG])
      [σF] = proj₁ ([F] ⊢Δ [σ])
      ⊢σF = escape [σF]
      [σG] = proj₁ ([G] (⊢Δ ∙ ⊢σF) (liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]))
      ⊢σH = escape (proj₁ ([H] ⊢Δ [σ]))
      ⊢σE = escape (proj₁ ([E] (⊢Δ ∙ ⊢σH) (liftSubstS {F = H} [Γ] ⊢Δ [H] [σ])))
      ⊢σF≡σH = escapeEq [σF] ([F≡H] ⊢Δ [σ])
      ⊢σG≡σE = escapeEq [σG] ([G≡E] (⊢Δ ∙ ⊢σF) (liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]))
  in  ∃₌ (subst σ H)
         (subst (liftSubst σ) E)
         (id (univ (∃ⱼ (un-univ ⊢σH) ▹ (un-univ ⊢σE))))
         (≅-univ (≅ₜ-∃-cong ⊢σF (≅-un-univ ⊢σF≡σH) (≅-un-univ ⊢σG≡σE)))
         (λ ρ ⊢Δ₁ → let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ ρ [σ]
                    in  irrelevanceEq″ (PE.sym (wk-subst F))
                                        (PE.sym (wk-subst H)) PE.refl PE.refl
                                        (proj₁ ([F] ⊢Δ₁ [ρσ]))
                                        ([F]′ ρ ⊢Δ₁)
                                        ([F≡H] ⊢Δ₁ [ρσ]))
         (λ {ρ} {Δ} {a} [ρ] ⊢Δ₁ [a] →
            let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                [a]′ = irrelevanceTerm′ (wk-subst F) PE.refl PE.refl
                                        ([F]′ [ρ] ⊢Δ₁)
                                        (proj₁ ([F] ⊢Δ₁ [ρσ])) [a]
                [aρσ] = consSubstS {t = a} {A = F} [Γ] ⊢Δ₁ [ρσ] [F] [a]′
            in irrelevanceEq″ (PE.sym (singleSubstWkComp a σ G))
                                (PE.sym (singleSubstWkComp a σ E)) PE.refl PE.refl
                                (proj₁ ([G] ⊢Δ₁ [aρσ]))
                                ([G]′ [ρ] ⊢Δ₁ [a])
                                ([G≡E] ⊢Δ₁ [aρσ])
                                )

-- Validity of ∃ as a term.

∃ᵗᵛ₁ : ∀ {F G l∃ Γ} ([Γ] : ⊩ᵛ Γ)→
      let l    = ∞
          [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
          [U∃] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      in
        ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
        ([UG] : Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [F])
      → Γ ⊩ᵛ⟨ l ⟩ F ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [UF]
      → Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ G ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [F] / (λ {Δ} {σ} → [UG] {Δ} {σ})
      → ∀ {Δ σ} (⊢Δ : ⊢ Δ) ([σ] : Δ ⊩ˢ σ ∷ Γ / [Γ] / ⊢Δ)
      → Δ ⊩⟨ l ⟩ subst σ (∃ F ▹ G) ∷ subst σ (Univ % l∃) ^ [ ! , next l∃ ] / proj₁ ([U∃] ⊢Δ [σ])
∃ᵗᵛ₁ {F} {G} {l∃ = ¹} {Γ} [Γ] [F] [UG] [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let
      l = ∞
      l∃ = ¹
      l∃≤ = ≡is≤ PE.refl
      [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      [U∃] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
      [liftσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
      univΔ = proj₁ ([UF] ⊢Δ [σ])
      [Fₜ]σ {σ′} [σ′] = [Fₜ] {σ = σ′} ⊢Δ [σ′]
      [σF] = proj₁ ([Fₜ]σ [σ])
      ⊢Fₜ = escapeTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ]))
      ⊢F≡Fₜ = escapeTermEq univΔ (reflEqTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ])))
      [UG]σ = proj₁ ([UG] {σ = liftSubst σ} (⊢Δ ∙ ⊢F) [liftσ])
      [Gₜ]σ = proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ])
      ⊢Gₜ = escapeTerm [UG]σ [Gₜ]σ
      ⊢G≡Gₜ = escapeTermEq [UG]σ (reflEqTerm [UG]σ [Gₜ]σ)
      [F]₀ = univᵛ {F} [Γ] l∃≤ [UF] [Fₜ]
      [UG]′ = S.irrelevance {A = Univ % l∃} {r = [ ! , next l∃ ]} (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀) (λ {Δ} {σ} → [UG] {Δ} {σ})
      [Gₜ]′ = S.irrelevanceTerm {l′ = ∞} {A = Univ % l∃} {t = G}
                                (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀)
                                (λ {Δ} {σ} → [UG] {Δ} {σ})
                                (λ {Δ} {σ} → [UG]′ {Δ} {σ})
                                [Gₜ]
      [G]₀ = univᵛ {G} (_∙_ {A = F} [Γ] [F]₀) l∃≤
                   (λ {Δ} {σ} → [UG]′ {Δ} {σ}) (λ {Δ} {σ} → [Gₜ]′ {Δ} {σ})
      [Guniv] = univᵛ {A = G} (_∙_ {A = F} [Γ] [F]₀) l∃≤ (λ {Δ} {σ} → [UG]′ {Δ} {σ}) [Gₜ]′
  in  Uₜ (∃ subst σ F ▹ subst (liftSubst σ) G) (idRedTerm:*: (∃ⱼ ⊢Fₜ ▹ ⊢Gₜ))  ∃ₙ (≅ₜ-∃-cong ⊢F ⊢F≡Fₜ ⊢G≡Gₜ)
         (λ {ρ} {Δ₁} [ρ] ⊢Δ₁ → let
                            ⊢Fₜ' = Definition.Typed.Weakening.wkTerm [ρ] ⊢Δ₁ ⊢Fₜ
                            ⊢Gₜ' = Definition.Typed.Weakening.wkTerm
                                      (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') ⊢Gₜ
                            [wkFₜ] = wkTerm [ρ] ⊢Δ₁ univΔ (proj₁ ([Fₜ] ⊢Δ [σ]))
                            [wkGₜ] = wkTerm (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] {σ = liftSubst σ} (⊢Δ ∙ ⊢F) [liftσ])) (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]))
                            [⊢weakF≡Fₜ] = escapeTermEq (wk [ρ] ⊢Δ₁ univΔ)
                                                       (reflEqTerm (wk [ρ] ⊢Δ₁ univΔ) [wkFₜ])
                            [⊢weakG≡Gₜ] = escapeTermEq (wk (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ])))
                                                       (reflEqTerm (wk (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ])))
                                                       (wkTerm (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ])) (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]))))
                            [wkFₜ]Type : ∀ {ρ₁ Δ₂} [ρ₁] ⊢Δ₂ → Δ₂ ⊩⟨ ι ¹ ⟩ U.wk ρ₁ (U.wk ρ (subst σ F)) ^ [ % , ι l∃ ]
                            [wkFₜ]Type = λ {ρ₁} {Δ₂} [ρ₁] ⊢Δ₂ → let [wkFₜ]Type = univEq (wk [ρ₁] ⊢Δ₂ (wk [ρ] ⊢Δ₁ univΔ))
                                                                      (wkTerm [ρ₁] ⊢Δ₂ (wk [ρ] ⊢Δ₁ univΔ) [wkFₜ])
                                                   in maybeEmb′ l∃≤ [wkFₜ]Type
                            in ∃ᵣ′ (U.wk ρ (subst σ F)) (U.wk (lift ρ) (subst (liftSubst σ) G))
                                  (idRed:*: (univ (∃ⱼ ⊢Fₜ' ▹ ⊢Gₜ')))
                                  (univ ⊢Fₜ') (univ ⊢Gₜ') (≅-univ (≅ₜ-∃-cong (univ ⊢Fₜ') [⊢weakF≡Fₜ] [⊢weakG≡Gₜ]))
                                  [wkFₜ]Type
                                  (λ {ρ₁} {Δ₂} {a} [ρ₁] ⊢Δ₂ [a] →
                                    let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₂ ([ρ₁] •ₜ [ρ]) [σ]
                                        [a]′ = irrelevanceTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [a]
                                        [Gapp] = Gapp {F = F} {G = G} {σ = σ} [Γ] [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′
                                    in PE.subst (λ X → _ ⊩⟨ ι ¹ ⟩ X ^ _) (wk-comp-subst _ _ (subst (liftSubst σ) G)) [Gapp])
                                  (λ {ρ₁} {Δ₂} {a} {b} [ρ₁] ⊢Δ₂ [a] [b] [a≡b] →
                                    let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₂ ([ρ₁] •ₜ [ρ]) [σ]
                                        [a]′ = irrelevanceTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [a]
                                        [b]′ = irrelevanceTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [b]
                                        [a≡b]′ = irrelevanceEqTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [a≡b]
                                        [Gapp] = Gapp {F = F} {G = G} {σ = σ} [Γ]  [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′
                                     in irrelevanceEq″ (PE.trans (PE.sym (singleSubstWkComp a σ G)) (wk-comp-subst {a} ρ₁ ρ (subst (liftSubst σ) G)))
                                                       (PE.trans (PE.sym (singleSubstWkComp b σ G)) (wk-comp-subst {b} ρ₁ ρ (subst (liftSubst σ) G)))
                                                       PE.refl PE.refl
                                                       (proj₁ (GappGen {F = F} {G = G} {σ = σ} [Γ]  [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′ ))
                                                       (PE.subst (λ X → _ ⊩⟨ ι ¹ ⟩ X ^ _) (wk-comp-subst _ _ (subst (liftSubst σ) G)) [Gapp])
                                                       (proj₂ (GappGen {F = F} {G = G} {σ = σ} [Γ]  [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′ )
                                                         ([ρσ] , [b]′) (reflSubst [Γ] ⊢Δ₂ [ρσ] , [a≡b]′))))
∃ᵗᵛ₁ {F} {G} {l∃ = ⁰} {Γ} [Γ] [F] [UG] [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let
      l = ∞
      l∃ = ⁰
      l∃≤ = ≡is≤ PE.refl
      [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      [U∃] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
      [liftσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
      univΔ = proj₁ ([UF] ⊢Δ [σ])
      [Fₜ]σ {σ′} [σ′] = [Fₜ] {σ = σ′} ⊢Δ [σ′]
      [σF] = proj₁ ([Fₜ]σ [σ])
      ⊢Fₜ = escapeTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ]))
      ⊢F≡Fₜ = escapeTermEq univΔ (reflEqTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ])))
      [UG]σ = proj₁ ([UG] {σ = liftSubst σ} (⊢Δ ∙ ⊢F) [liftσ])
      [Gₜ]σ = proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ])
      ⊢Gₜ = escapeTerm [UG]σ [Gₜ]σ
      ⊢G≡Gₜ = escapeTermEq [UG]σ (reflEqTerm [UG]σ [Gₜ]σ)
      [F]₀ = univᵛ {F} [Γ] l∃≤ [UF] [Fₜ]
      [UG]′ = S.irrelevance {A = Univ % l∃} {r = [ ! , next l∃ ]} (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀) (λ {Δ} {σ} → [UG] {Δ} {σ})
      [Gₜ]′ = S.irrelevanceTerm {l′ = ∞} {A = Univ % l∃} {t = G}
                                (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀)
                                (λ {Δ} {σ} → [UG] {Δ} {σ})
                                (λ {Δ} {σ} → [UG]′ {Δ} {σ})
                                [Gₜ]
      [G]₀ = univᵛ {G} (_∙_ {A = F} [Γ] [F]₀) l∃≤
                   (λ {Δ} {σ} → [UG]′ {Δ} {σ}) (λ {Δ} {σ} → [Gₜ]′ {Δ} {σ})
      [Guniv] = univᵛ {A = G} (_∙_ {A = F} [Γ] [F]₀) l∃≤ (λ {Δ} {σ} → [UG]′ {Δ} {σ}) [Gₜ]′
  in  Uₜ (∃ subst σ F ▹ subst (liftSubst σ) G) (idRedTerm:*: (∃ⱼ ⊢Fₜ ▹ ⊢Gₜ))  ∃ₙ (≅ₜ-∃-cong ⊢F ⊢F≡Fₜ ⊢G≡Gₜ)
         (λ {ρ} {Δ₁} [ρ] ⊢Δ₁ → let
                            ⊢Fₜ' = Definition.Typed.Weakening.wkTerm [ρ] ⊢Δ₁ ⊢Fₜ
                            ⊢Gₜ' = Definition.Typed.Weakening.wkTerm
                                      (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') ⊢Gₜ
                            [wkFₜ] = wkTerm [ρ] ⊢Δ₁ univΔ (proj₁ ([Fₜ] ⊢Δ [σ]))
                            [wkGₜ] = wkTerm (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] {σ = liftSubst σ} (⊢Δ ∙ ⊢F) [liftσ])) (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]))
                            [⊢weakF≡Fₜ] = escapeTermEq (wk [ρ] ⊢Δ₁ univΔ)
                                                       (reflEqTerm (wk [ρ] ⊢Δ₁ univΔ) [wkFₜ])
                            [⊢weakG≡Gₜ] = escapeTermEq (wk (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ])))
                                                       (reflEqTerm (wk (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ])))
                                                       (wkTerm (Definition.Typed.Weakening.lift [ρ]) (⊢Δ₁ ∙ univ ⊢Fₜ') (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ])) (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]))))
                            [wkFₜ]Type : ∀ {ρ₁ Δ₂} [ρ₁] ⊢Δ₂ → Δ₂ ⊩⟨ ι ⁰ ⟩ U.wk ρ₁ (U.wk ρ (subst σ F)) ^ [ % , ι l∃ ]
                            [wkFₜ]Type = λ {ρ₁} {Δ₂} [ρ₁] ⊢Δ₂ → let [wkFₜ]Type = univEq (wk [ρ₁] ⊢Δ₂ (wk [ρ] ⊢Δ₁ univΔ))
                                                                      (wkTerm [ρ₁] ⊢Δ₂ (wk [ρ] ⊢Δ₁ univΔ) [wkFₜ])
                                                   in maybeEmb′ l∃≤ [wkFₜ]Type
                            in ∃ᵣ′ (U.wk ρ (subst σ F)) (U.wk (lift ρ) (subst (liftSubst σ) G))
                                  (idRed:*: (univ (∃ⱼ ⊢Fₜ' ▹ ⊢Gₜ')))
                                  (univ ⊢Fₜ') (univ ⊢Gₜ') (≅-univ (≅ₜ-∃-cong (univ ⊢Fₜ') [⊢weakF≡Fₜ] [⊢weakG≡Gₜ]))
                                  [wkFₜ]Type
                                  (λ {ρ₁} {Δ₂} {a} [ρ₁] ⊢Δ₂ [a] →
                                    let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₂ ([ρ₁] •ₜ [ρ]) [σ]
                                        [a]′ = irrelevanceTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [a]
                                        [Gapp] = Gapp {F = F} {G = G} {σ = σ} [Γ] [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′
                                    in PE.subst (λ X → _ ⊩⟨ ι ⁰ ⟩ X ^ _) (wk-comp-subst _ _ (subst (liftSubst σ) G)) [Gapp])
                                  (λ {ρ₁} {Δ₂} {a} {b} [ρ₁] ⊢Δ₂ [a] [b] [a≡b] →
                                    let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₂ ([ρ₁] •ₜ [ρ]) [σ]
                                        [a]′ = irrelevanceTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [a]
                                        [b]′ = irrelevanceTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [b]
                                        [a≡b]′ = irrelevanceEqTerm′ (wk-subst2 {ρ} {ρ₁} {σ} F) PE.refl PE.refl ([wkFₜ]Type [ρ₁] ⊢Δ₂)
                                               (proj₁ ([F]₀ ⊢Δ₂ [ρσ])) [a≡b]
                                        [Gapp] = Gapp {F = F} {G = G} {σ = σ} [Γ]  [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′
                                     in irrelevanceEq″ (PE.trans (PE.sym (singleSubstWkComp a σ G)) (wk-comp-subst {a} ρ₁ ρ (subst (liftSubst σ) G)))
                                                       (PE.trans (PE.sym (singleSubstWkComp b σ G)) (wk-comp-subst {b} ρ₁ ρ (subst (liftSubst σ) G)))
                                                       PE.refl PE.refl
                                                       (proj₁ (GappGen {F = F} {G = G} {σ = σ} [Γ]  [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′ ))
                                                       (PE.subst (λ X → _ ⊩⟨ ι ⁰ ⟩ X ^ _) (wk-comp-subst _ _ (subst (liftSubst σ) G)) [Gapp])
                                                       (proj₂ (GappGen {F = F} {G = G} {σ = σ} [Γ]  [F]₀ [Guniv] ⊢Δ [σ] a ([ρ₁] •ₜ [ρ]) ⊢Δ₂ [a]′ )
                                                         ([ρσ] , [b]′) (reflSubst [Γ] ⊢Δ₂ [ρσ] , [a≡b]′))))

∃ᵗᵛ : ∀ {F G l∃ Γ} ([Γ] : ⊩ᵛ Γ)→
      let l    = ∞
          [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
          [U∃] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      in
        ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
        ([UG] : Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [F])
      → Γ ⊩ᵛ⟨ l ⟩ F ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [UF]
      → Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ G ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [F] / (λ {Δ} {σ} → [UG] {Δ} {σ})
      → Γ ⊩ᵛ⟨ l ⟩ ∃ F ▹ G ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [U∃]
∃ᵗᵛ {F} {G} {l∃ = ¹} {Γ} [Γ] [F] [UG] [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let l = ∞
      l∃ = ¹
      l∃≤ = ≡is≤ PE.refl
      [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
  in ∃ᵗᵛ₁ {F} {G} {¹} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ]
    , (λ {σ′} [σ′] [σ≡σ′] →
         let ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
             [liftσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
             univΔ = proj₁ ([UF] ⊢Δ [σ])
             [Fₜ]σ {σ′} [σ′] = [Fₜ] {σ = σ′} ⊢Δ [σ′]
             [σF] = proj₁ ([Fₜ]σ [σ])
             ⊢Fₜ = escapeTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ]))
             ⊢F≡Fₜ = escapeTermEq univΔ (reflEqTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ])))
             [liftσ′] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ′]
             [wk1σ] = wk1SubstS [Γ] ⊢Δ ⊢F [σ]
             [wk1σ′] = wk1SubstS [Γ] ⊢Δ ⊢F [σ′]
             var0 = conv (var (⊢Δ ∙ ⊢F)
                         (PE.subst (λ x → 0 ∷ x ^ [ % , ι l∃ ] ∈ (Δ ∙ subst σ F ^ [ % , ι l∃ ]))
                                   (wk-subst F) here))
                    (≅-eq (escapeEq (proj₁ ([F] (⊢Δ ∙ ⊢F) [wk1σ]))
                                        (proj₂ ([F] (⊢Δ ∙ ⊢F) [wk1σ]) [wk1σ′]
                                               (wk1SubstSEq [Γ] ⊢Δ ⊢F [σ] [σ≡σ′]))))
             [liftσ′]′ = [wk1σ′]
                       , neuTerm (proj₁ ([F] (⊢Δ ∙ ⊢F) [wk1σ′])) (var 0)
                                 var0 (~-var var0)
             ⊢F′ = escape (proj₁ ([F] ⊢Δ [σ′]))
             univΔ = proj₁ ([UF] ⊢Δ [σ])
             univΔ′ = proj₁ ([UF] ⊢Δ [σ′])
             [Fₜ]σ {σ′} [σ′] = [Fₜ] {σ = σ′} ⊢Δ [σ′]
             [σF] = proj₁ ([Fₜ]σ [σ])
             ⊢Fₜ′ = escapeTerm univΔ′ (proj₁ ([Fₜ] ⊢Δ [σ′]))
             ⊢Gₜ′ = escapeTerm (proj₁ ([UG] {σ = liftSubst σ′} (⊢Δ ∙ ⊢F′) [liftσ′]))
                                  (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F′) [liftσ′]))
             ⊢F≡F′ = escapeTermEq univΔ (proj₂ ([Fₜ] ⊢Δ [σ]) [σ′] [σ≡σ′])
             ⊢G≡G′ = escapeTermEq (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ]))
                                     (proj₂ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]) [liftσ′]′
                                            (liftSubstSEq {F = F} [Γ] ⊢Δ [F] [σ] [σ≡σ′]))
             [F]₀ = univᵛ {F} [Γ] l∃≤ [UF] [Fₜ]
             [UG]′ = S.irrelevance {A = Univ % l∃} {r = [ ! , next l∃ ]} (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀) (λ {Δ} {σ} → [UG] {Δ} {σ})
             [Gₜ]′ = S.irrelevanceTerm {l′ = ∞} {A = Univ % l∃} {t = G}
                                (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀)
                                (λ {Δ} {σ} → [UG] {Δ} {σ})
                                (λ {Δ} {σ} → [UG]′ {Δ} {σ})
                                [Gₜ]
             [G]₀ = univᵛ {G} (_∙_ {A = F} [Γ] [F]₀) l∃≤
                   (λ {Δ} {σ} → [UG]′ {Δ} {σ}) (λ {Δ} {σ} → [Gₜ]′ {Δ} {σ})
             [∃FG-cong] = ∃-congᵛ {F} {G} {F} {G} [Γ] [F]₀ [G]₀ [F]₀ [G]₀
                                  (λ ⊢Δ₁ [σ]₁ → proj₂ ([F]₀ ⊢Δ₁ [σ]₁) [σ]₁ (reflSubst [Γ] ⊢Δ₁ [σ]₁))
                                  (λ {Δ₁} {σ₁} ⊢Δ₁ [σ]₁ → proj₂ ([G]₀ ⊢Δ₁ [σ]₁) [σ]₁ (reflSubst {σ₁} ((_∙_ {A = F} [Γ] [F]₀)) ⊢Δ₁ [σ]₁))
             [∃FG]ᵗ  = ∃ᵗᵛ₁ {F} {G} {l∃ = ¹} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ]
             [∃FG]ᵗ′ = ∃ᵗᵛ₁ {F} {G} {l∃ = ¹} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [Fₜ] [Gₜ] {Δ = Δ} {σ = σ′} ⊢Δ [σ′]
             [∃FG]  = ∃ᵛ {F} {G} {Γ} {l∃ = ¹} [Γ] [F]₀ [G]₀
          in Uₜ₌ [∃FG]ᵗ
                 [∃FG]ᵗ′
                 (≅ₜ-∃-cong ⊢F ⊢F≡F′ ⊢G≡G′)
                 (λ {ρ} {Δ₁} [ρ] ⊢Δ₁ → let [∃FG-cong]′ = [∃FG-cong] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])
                                           X = irrelevanceEq″ (PE.sym (wk-subst (∃ F ▹ G)))
                                                              (PE.sym (wk-subst (∃ F ▹ G)))
                                                              PE.refl PE.refl
                                                              (proj₁ ([∃FG] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])))
                                                              (LogRel._⊩¹U_∷_^_/_.[t] [∃FG]ᵗ [ρ] ⊢Δ₁)
                                                              [∃FG-cong]′
                                           [σ∃FG] = proj₁ ([∃FG] ⊢Δ [σ])
                                           _ , ∃ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmb (∃-elim [σ∃FG])
                                           [ρσ] =  wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                                           [σF]₀ = proj₁ ([F]₀ ⊢Δ₁ [ρσ])
                                           ⊢σF₀ = escape [σF]₀
                                           [σG]₀ = proj₁ ([G]₀ (⊢Δ₁ ∙ ⊢σF₀) (liftSubstS {F = F} [Γ] ⊢Δ₁ [F]₀ [ρσ]))
                                           [ρσ′] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ′]
                                           [σF′]₀ = proj₁ ([F]₀ ⊢Δ₁ [ρσ′])
                                           ⊢σH = escape (proj₁ ([F]₀ ⊢Δ₁ [ρσ′]))
                                           ⊢σE = escape (proj₁ ([G]₀ (⊢Δ₁ ∙ ⊢σH) (liftSubstS {F = F} [Γ] ⊢Δ₁ [F]₀ [ρσ′])))
                                           univΔ₁ = proj₁ ([UF] ⊢Δ₁ [ρσ])
                                           [ρσ≡ρσ′] = wkSubstSEq [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ] [σ≡σ′]
                                           [σF≡σH] = univEqEq univΔ₁ [σF]₀ (proj₂ ([Fₜ] ⊢Δ₁ [ρσ]) [ρσ′] [ρσ≡ρσ′])
                                           ⊢σF≡σH = escapeEq [σF]₀ [σF≡σH]
                                           [σF] = proj₁ ([F] ⊢Δ₁ [ρσ])
                                           ⊢σF = escape [σF]
                                           liftσ = liftSubstS {F = F} [Γ] ⊢Δ₁ [F] [ρσ]
                                           [wk1σ] = wk1SubstS [Γ] ⊢Δ₁ ⊢σF [ρσ]
                                           [wk1σ′] = wk1SubstS [Γ] ⊢Δ₁ ⊢σF [ρσ′]
                                           var0 = conv (var (⊢Δ₁ ∙ ⊢σF)
                                                            (PE.subst (λ x → 0 ∷ x ^ [ % , ι l∃ ] ∈ (Δ₁ ∙ subst (ρ •ₛ σ) F ^ [ % , ι l∃ ]))
                                                            (wk-subst F) here))
                                                       (≅-eq (escapeEq (proj₁ ([F] (⊢Δ₁ ∙ ⊢σF) [wk1σ]))
                                                            (proj₂ ([F] (⊢Δ₁ ∙ ⊢σF) [wk1σ]) [wk1σ′]
                                                            (wk1SubstSEq [Γ] ⊢Δ₁ ⊢σF [ρσ] [ρσ≡ρσ′]))))
                                           [liftσ′]′  : (Δ₁ ∙ subst (ρ •ₛ σ) F ^ [ % , ι l∃ ]) ⊩ˢ liftSubst (ρ •ₛ σ′) ∷
                                                            Γ ∙ F ^ [ % , ι l∃ ] / [Γ] ∙ [F] /
                                                        (⊢Δ₁ ∙ escape (proj₁ ([F] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]))))
                                           [liftσ′]′ = [wk1σ′]
                                                       , neuTerm (proj₁ ([F] (⊢Δ₁ ∙ ⊢σF) [wk1σ′])) (var 0)
                                                                 var0 (~-var var0)
                                           liftσ′ = liftSubstS {F = F} [Γ] ⊢Δ₁ [F] [ρσ′]
                                           univΔ₁G = proj₁ ([UG] (⊢Δ₁ ∙ ⊢σF) liftσ)
                                           [σG≡σE] = univEqEq univΔ₁G [σG]₀ (proj₂ ([Gₜ] {σ = liftSubst (ρ •ₛ σ)} (⊢Δ₁ ∙ ⊢σF) liftσ) [liftσ′]′
                                                             (liftSubstSEq {F = F} [Γ] ⊢Δ₁ [F] [ρσ] [ρσ≡ρσ′]))
                                           ⊢σG≡σE = escapeEq [σG]₀ [σG≡σE]
                                           X = ∃₌  (subst (ρ •ₛ σ′) F)
                                                   (subst (liftSubst (ρ •ₛ σ′)) G)
                                                   (id (univ (∃ⱼ (un-univ ⊢σH) ▹ (un-univ ⊢σE))))
                                                   ((≅-univ (≅ₜ-∃-cong ⊢σF (≅-un-univ ⊢σF≡σH) (≅-un-univ ⊢σG≡σE))))
                                                   (λ {ρ₂} {Δ₂} [ρ₂] ⊢Δ₂ →
                                                   let
                                                       [ρσ₂] =  wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ]
                                                       [ρσ₂F]₀ = proj₁ ([F]₀ ⊢Δ₂ [ρσ₂])
                                                       [σ∃FG] = proj₁ ([∃FG] ⊢Δ₁ [ρσ])
                                                       _ , ∃ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmb (∃-elim [σ∃FG])
                                                       ⊢ρσ₂F = escape [ρσ₂F]₀
                                                       [ρσ₂′] = wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ′]
                                                       ⊢σH = escape (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂′]))
                                                       univΔ₂ = proj₁ ([UF] ⊢Δ₂ [ρσ₂])
                                                       [σF≡σH] = univEqEq univΔ₂ [ρσ₂F]₀ (proj₂ ([Fₜ]  ⊢Δ₂ [ρσ₂]) [ρσ₂′]
                                                                                (wkSubstSEq [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ] [ρσ≡ρσ′]))
                                                   in irrelevanceEq″ (PE.sym (wk-subst F))
                                                                      (PE.sym (wk-subst F)) PE.refl PE.refl
                                                                      [ρσ₂F]₀
                                                                      ([F]′ [ρ₂] ⊢Δ₂)
                                                                      [σF≡σH])
                                                   (λ {ρ₂} {Δ₂} {a} [ρ₂] ⊢Δ₂ [a] →
                                                    let [ρσ₂] =  wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ]
                                                        [ρσ₂F]₀ = proj₁ ([F]₀ ⊢Δ₂ [ρσ₂])
                                                        [σ∃FG] = proj₁ ([∃FG] ⊢Δ₁ [ρσ])
                                                        _ , ∃ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmb (∃-elim [σ∃FG])
                                                        ⊢ρσ₂F = escape [ρσ₂F]₀
                                                        [ρσ₂′] = wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ′]
                                                        ⊢σH = escape (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂′]))
                                                        univΔ₂ = proj₁ ([UF] ⊢Δ₂ [ρσ₂])
                                                        [a]′ = irrelevanceTerm′
                                                                 (wk-subst F) PE.refl PE.refl (wk [ρ₂] ⊢Δ₂ [σF]₀)
                                                                 (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂])) [a]
                                                        [a]″ = convTerm₁ (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂]))
                                                                         (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂′]))
                                                                         (proj₂ ([F]₀ ⊢Δ₂ [ρσ₂]) [ρσ₂′]
                                                                         (wkSubstSEq [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ] [ρσ≡ρσ′]))
                                                                         [a]′
                                                        [ρσa≡ρσ′a] = consSubstSEq {t = a} {A = F} [Γ] ⊢Δ₂
                                                                                (wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ])
                                                                                (wkSubstSEq [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ] [ρσ≡ρσ′])
                                                                                [F]₀ [a]′
                                                    in irrelevanceEq″
                                                         (PE.sym (singleSubstWkComp a (ρ •ₛ σ) G))
                                                         (PE.sym (singleSubstWkComp a (ρ •ₛ σ′) G)) PE.refl PE.refl
                                                         (proj₁ (GappGen {F = F} {G = G} {σ = _} [Γ] [F]₀ [G]₀ ⊢Δ₁ [ρσ] a [ρ₂] ⊢Δ₂ [a]′))
                                                         (Gapp {F = F} {G = G} {σ = _} [Γ] [F]₀ [G]₀ ⊢Δ₁ [ρσ] a [ρ₂] ⊢Δ₂ [a]′)
                                                         (proj₂ (GappGen {F = F} {G = G} {σ = _} [Γ] [F]₀ [G]₀ ⊢Δ₁ [ρσ] a [ρ₂] ⊢Δ₂ [a]′)
                                                                ([ρσ₂′] , [a]″)
                                                                [ρσa≡ρσ′a] ))
                                        in irrelevanceEq″ (PE.sym (wk-subst (∃ F ▹ G)))
                                                          (PE.sym (wk-subst (∃ F ▹ G)))
                                                          PE.refl PE.refl
                                                          (proj₁ ([∃FG] ⊢Δ₁ [ρσ]))
                                                          (LogRel._⊩¹U_∷_^_/_.[t] [∃FG]ᵗ [ρ] ⊢Δ₁)
                                                          X))
∃ᵗᵛ {F} {G} {l∃ = ⁰} {Γ} [Γ] [F] [UG] [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ] =
  let l = ∞
      l∃ = ⁰
      l∃≤ = ≡is≤ PE.refl
      [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
  in ∃ᵗᵛ₁ {F} {G} {⁰} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ]
    , (λ {σ′} [σ′] [σ≡σ′] →
         let ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
             [liftσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
             univΔ = proj₁ ([UF] ⊢Δ [σ])
             [Fₜ]σ {σ′} [σ′] = [Fₜ] {σ = σ′} ⊢Δ [σ′]
             [σF] = proj₁ ([Fₜ]σ [σ])
             ⊢Fₜ = escapeTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ]))
             ⊢F≡Fₜ = escapeTermEq univΔ (reflEqTerm univΔ (proj₁ ([Fₜ] ⊢Δ [σ])))
             [liftσ′] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ′]
             [wk1σ] = wk1SubstS [Γ] ⊢Δ ⊢F [σ]
             [wk1σ′] = wk1SubstS [Γ] ⊢Δ ⊢F [σ′]
             var0 = conv (var (⊢Δ ∙ ⊢F)
                         (PE.subst (λ x → 0 ∷ x ^ [ % , ι l∃ ] ∈ (Δ ∙ subst σ F ^ [ % , ι l∃ ]))
                                   (wk-subst F) here))
                    (≅-eq (escapeEq (proj₁ ([F] (⊢Δ ∙ ⊢F) [wk1σ]))
                                        (proj₂ ([F] (⊢Δ ∙ ⊢F) [wk1σ]) [wk1σ′]
                                               (wk1SubstSEq [Γ] ⊢Δ ⊢F [σ] [σ≡σ′]))))
             [liftσ′]′ = [wk1σ′]
                       , neuTerm (proj₁ ([F] (⊢Δ ∙ ⊢F) [wk1σ′])) (var 0)
                                 var0 (~-var var0)
             ⊢F′ = escape (proj₁ ([F] ⊢Δ [σ′]))
             univΔ = proj₁ ([UF] ⊢Δ [σ])
             univΔ′ = proj₁ ([UF] ⊢Δ [σ′])
             [Fₜ]σ {σ′} [σ′] = [Fₜ] {σ = σ′} ⊢Δ [σ′]
             [σF] = proj₁ ([Fₜ]σ [σ])
             ⊢Fₜ′ = escapeTerm univΔ′ (proj₁ ([Fₜ] ⊢Δ [σ′]))
             ⊢Gₜ′ = escapeTerm (proj₁ ([UG] {σ = liftSubst σ′} (⊢Δ ∙ ⊢F′) [liftσ′]))
                                  (proj₁ ([Gₜ] (⊢Δ ∙ ⊢F′) [liftσ′]))
             ⊢F≡F′ = escapeTermEq univΔ (proj₂ ([Fₜ] ⊢Δ [σ]) [σ′] [σ≡σ′])
             ⊢G≡G′ = escapeTermEq (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ]))
                                     (proj₂ ([Gₜ] (⊢Δ ∙ ⊢F) [liftσ]) [liftσ′]′
                                            (liftSubstSEq {F = F} [Γ] ⊢Δ [F] [σ] [σ≡σ′]))
             [F]₀ = univᵛ {F} [Γ] (≡is≤ PE.refl) [UF] [Fₜ]
             [UG]′ = S.irrelevance {A = Univ % l∃} {r = [ ! , next l∃ ]} (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀) (λ {Δ} {σ} → [UG] {Δ} {σ})
             [Gₜ]′ = S.irrelevanceTerm {l′ = ∞} {A = Univ % l∃} {t = G}
                                (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F]₀)
                                (λ {Δ} {σ} → [UG] {Δ} {σ})
                                (λ {Δ} {σ} → [UG]′ {Δ} {σ})
                                [Gₜ]
             [G]₀ = univᵛ {G} (_∙_ {A = F} [Γ] [F]₀) l∃≤
                   (λ {Δ} {σ} → [UG]′ {Δ} {σ}) (λ {Δ} {σ} → [Gₜ]′ {Δ} {σ})
             [∃FG-cong] = ∃-congᵛ {F} {G} {F} {G} [Γ] [F]₀ [G]₀ [F]₀ [G]₀
                                  (λ ⊢Δ₁ [σ]₁ → proj₂ ([F]₀ ⊢Δ₁ [σ]₁) [σ]₁ (reflSubst [Γ] ⊢Δ₁ [σ]₁))
                                  (λ {Δ₁} {σ₁} ⊢Δ₁ [σ]₁ → proj₂ ([G]₀ ⊢Δ₁ [σ]₁) [σ]₁ (reflSubst {σ₁} ((_∙_ {A = F} [Γ] [F]₀)) ⊢Δ₁ [σ]₁))
             [∃FG]ᵗ  = ∃ᵗᵛ₁ {F} {G} {l∃ = ⁰} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ]
             [∃FG]ᵗ′ = ∃ᵗᵛ₁ {F} {G} {l∃ = ⁰} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [Fₜ] [Gₜ] {Δ = Δ} {σ = σ′} ⊢Δ [σ′]
             [∃FG]  = ∃ᵛ {F} {G} {Γ} {l∃ = ⁰} [Γ] [F]₀ [G]₀
          in Uₜ₌ [∃FG]ᵗ
                 [∃FG]ᵗ′
                 (≅ₜ-∃-cong ⊢F ⊢F≡F′ ⊢G≡G′)
                 (λ {ρ} {Δ₁} [ρ] ⊢Δ₁ → let [∃FG-cong]′ = [∃FG-cong] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])
                                           X = irrelevanceEq″ (PE.sym (wk-subst (∃ F ▹ G)))
                                                              (PE.sym (wk-subst (∃ F ▹ G)))
                                                              PE.refl PE.refl
                                                              (proj₁ ([∃FG] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ])))
                                                              (LogRel._⊩¹U_∷_^_/_.[t] [∃FG]ᵗ [ρ] ⊢Δ₁)
                                                              [∃FG-cong]′
                                           [σ∃FG] = proj₁ ([∃FG] ⊢Δ [σ])
                                           _ , ∃ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmb (∃-elim [σ∃FG])
                                           [ρσ] =  wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                                           [σF]₀ = proj₁ ([F]₀ ⊢Δ₁ [ρσ])
                                           ⊢σF₀ = escape [σF]₀
                                           [σG]₀ = proj₁ ([G]₀ (⊢Δ₁ ∙ ⊢σF₀) (liftSubstS {F = F} [Γ] ⊢Δ₁ [F]₀ [ρσ]))
                                           [ρσ′] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ′]
                                           [σF′]₀ = proj₁ ([F]₀ ⊢Δ₁ [ρσ′])
                                           ⊢σH = escape (proj₁ ([F]₀ ⊢Δ₁ [ρσ′]))
                                           ⊢σE = escape (proj₁ ([G]₀ (⊢Δ₁ ∙ ⊢σH) (liftSubstS {F = F} [Γ] ⊢Δ₁ [F]₀ [ρσ′])))
                                           univΔ₁ = proj₁ ([UF] ⊢Δ₁ [ρσ])
                                           [ρσ≡ρσ′] = wkSubstSEq [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ] [σ≡σ′]
                                           [σF≡σH] = univEqEq univΔ₁ [σF]₀ (proj₂ ([Fₜ] ⊢Δ₁ [ρσ]) [ρσ′] [ρσ≡ρσ′])
                                           ⊢σF≡σH = escapeEq [σF]₀ [σF≡σH]
                                           [σF] = proj₁ ([F] ⊢Δ₁ [ρσ])
                                           ⊢σF = escape [σF]
                                           liftσ = liftSubstS {F = F} [Γ] ⊢Δ₁ [F] [ρσ]
                                           [wk1σ] = wk1SubstS [Γ] ⊢Δ₁ ⊢σF [ρσ]
                                           [wk1σ′] = wk1SubstS [Γ] ⊢Δ₁ ⊢σF [ρσ′]
                                           var0 = conv (var (⊢Δ₁ ∙ ⊢σF)
                                                            (PE.subst (λ x → 0 ∷ x ^ [ % , ι l∃ ] ∈ (Δ₁ ∙ subst (ρ •ₛ σ) F ^ [ % , ι l∃ ]))
                                                            (wk-subst F) here))
                                                       (≅-eq (escapeEq (proj₁ ([F] (⊢Δ₁ ∙ ⊢σF) [wk1σ]))
                                                            (proj₂ ([F] (⊢Δ₁ ∙ ⊢σF) [wk1σ]) [wk1σ′]
                                                            (wk1SubstSEq [Γ] ⊢Δ₁ ⊢σF [ρσ] [ρσ≡ρσ′]))))
                                           [liftσ′]′  : (Δ₁ ∙ subst (ρ •ₛ σ) F ^ [ % , ι l∃ ]) ⊩ˢ liftSubst (ρ •ₛ σ′) ∷
                                                            Γ ∙ F ^ [ % , ι l∃ ] / [Γ] ∙ [F] /
                                                        (⊢Δ₁ ∙ escape (proj₁ ([F] ⊢Δ₁ (wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]))))
                                           [liftσ′]′ = [wk1σ′]
                                                       , neuTerm (proj₁ ([F] (⊢Δ₁ ∙ ⊢σF) [wk1σ′])) (var 0)
                                                                 var0 (~-var var0)
                                           liftσ′ = liftSubstS {F = F} [Γ] ⊢Δ₁ [F] [ρσ′]
                                           univΔ₁G = proj₁ ([UG] (⊢Δ₁ ∙ ⊢σF) liftσ)
                                           [σG≡σE] = univEqEq univΔ₁G [σG]₀ (proj₂ ([Gₜ] {σ = liftSubst (ρ •ₛ σ)} (⊢Δ₁ ∙ ⊢σF) liftσ) [liftσ′]′
                                                             (liftSubstSEq {F = F} [Γ] ⊢Δ₁ [F] [ρσ] [ρσ≡ρσ′]))
                                           ⊢σG≡σE = escapeEq [σG]₀ [σG≡σE]
                                           X = ∃₌  (subst (ρ •ₛ σ′) F)
                                                   (subst (liftSubst (ρ •ₛ σ′)) G)
                                                   (id (univ (∃ⱼ (un-univ ⊢σH) ▹ (un-univ ⊢σE))))
                                                   ((≅-univ (≅ₜ-∃-cong ⊢σF (≅-un-univ ⊢σF≡σH) (≅-un-univ ⊢σG≡σE))))
                                                   (λ {ρ₂} {Δ₂} [ρ₂] ⊢Δ₂ →
                                                   let
                                                       [ρσ₂] =  wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ]
                                                       [ρσ₂F]₀ = proj₁ ([F]₀ ⊢Δ₂ [ρσ₂])
                                                       [σ∃FG] = proj₁ ([∃FG] ⊢Δ₁ [ρσ])
                                                       _ , ∃ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmb (∃-elim [σ∃FG])
                                                       ⊢ρσ₂F = escape [ρσ₂F]₀
                                                       [ρσ₂′] = wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ′]
                                                       ⊢σH = escape (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂′]))
                                                       univΔ₂ = proj₁ ([UF] ⊢Δ₂ [ρσ₂])
                                                       [σF≡σH] = univEqEq univΔ₂ [ρσ₂F]₀ (proj₂ ([Fₜ]  ⊢Δ₂ [ρσ₂]) [ρσ₂′]
                                                                                (wkSubstSEq [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ] [ρσ≡ρσ′]))
                                                   in irrelevanceEq″ (PE.sym (wk-subst F))
                                                                      (PE.sym (wk-subst F)) PE.refl PE.refl
                                                                      [ρσ₂F]₀
                                                                      ([F]′ [ρ₂] ⊢Δ₂)
                                                                      [σF≡σH])
                                                   (λ {ρ₂} {Δ₂} {a} [ρ₂] ⊢Δ₂ [a] →
                                                    let [ρσ₂] =  wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ]
                                                        [ρσ₂F]₀ = proj₁ ([F]₀ ⊢Δ₂ [ρσ₂])
                                                        [σ∃FG] = proj₁ ([∃FG] ⊢Δ₁ [ρσ])
                                                        _ , ∃ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′ = extractMaybeEmb (∃-elim [σ∃FG])
                                                        ⊢ρσ₂F = escape [ρσ₂F]₀
                                                        [ρσ₂′] = wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ′]
                                                        ⊢σH = escape (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂′]))
                                                        univΔ₂ = proj₁ ([UF] ⊢Δ₂ [ρσ₂])
                                                        [a]′ = irrelevanceTerm′
                                                                 (wk-subst F) PE.refl PE.refl (wk [ρ₂] ⊢Δ₂ [σF]₀)
                                                                 (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂])) [a]
                                                        [a]″ = convTerm₁ (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂]))
                                                                         (proj₁ ([F]₀ ⊢Δ₂ [ρσ₂′]))
                                                                         (proj₂ ([F]₀ ⊢Δ₂ [ρσ₂]) [ρσ₂′]
                                                                         (wkSubstSEq [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ] [ρσ≡ρσ′]))
                                                                         [a]′
                                                        [ρσa≡ρσ′a] = consSubstSEq {t = a} {A = F} [Γ] ⊢Δ₂
                                                                                (wkSubstS [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ])
                                                                                (wkSubstSEq [Γ] ⊢Δ₁ ⊢Δ₂ [ρ₂] [ρσ] [ρσ≡ρσ′])
                                                                                [F]₀ [a]′
                                                    in irrelevanceEq″
                                                         (PE.sym (singleSubstWkComp a (ρ •ₛ σ) G))
                                                         (PE.sym (singleSubstWkComp a (ρ •ₛ σ′) G)) PE.refl PE.refl
                                                         (proj₁ (GappGen {F = F} {G = G} {σ = _} [Γ] [F]₀ [G]₀ ⊢Δ₁ [ρσ] a [ρ₂] ⊢Δ₂ [a]′))
                                                         (Gapp {F = F} {G = G} {σ = _} [Γ] [F]₀ [G]₀ ⊢Δ₁ [ρσ] a [ρ₂] ⊢Δ₂ [a]′)
                                                         (proj₂ (GappGen {F = F} {G = G} {σ = _} [Γ] [F]₀ [G]₀ ⊢Δ₁ [ρσ] a [ρ₂] ⊢Δ₂ [a]′)
                                                                ([ρσ₂′] , [a]″)
                                                                [ρσa≡ρσ′a] ))
                                        in irrelevanceEq″ (PE.sym (wk-subst (∃ F ▹ G)))
                                                          (PE.sym (wk-subst (∃ F ▹ G)))
                                                          PE.refl PE.refl
                                                          (proj₁ ([∃FG] ⊢Δ₁ [ρσ]))
                                                          (LogRel._⊩¹U_∷_^_/_.[t] [∃FG]ᵗ [ρ] ⊢Δ₁)
                                                          X))

-- Validity of ∃-congurence as a term equality.
∃-congᵗᵛ : ∀ {F G H E l∃ Γ} ([Γ] : ⊩ᵛ Γ) →
        let l    = ∞
            [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
            [U∃] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
        in
           ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
           ([H] : Γ ⊩ᵛ⟨ l ⟩ H ^ [ % , ι l∃ ] / [Γ])
           ([UG] : Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [F])
           ([UE] : Γ ∙ H ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [H])
           ([F]ₜ : Γ ⊩ᵛ⟨ l ⟩ F ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [UF])
           ([G]ₜ : Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ G ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [F] / (λ {Δ} {σ} → [UG] {Δ} {σ}))
           ([H]ₜ : Γ ⊩ᵛ⟨ l ⟩ H ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [UF])
           ([E]ₜ :  Γ ∙ H ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ E ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [H] / (λ {Δ} {σ} → [UE] {Δ} {σ}))
           ([F≡H]ₜ : Γ ⊩ᵛ⟨ l ⟩ F ≡ H ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [UF])
           ([G≡E]ₜ : Γ ∙ F ^ [ % , ι l∃ ] ⊩ᵛ⟨ l ⟩ G ≡ E ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] ∙ [F]
                                  / (λ {Δ} {σ} → [UG] {Δ} {σ}))
         → Γ ⊩ᵛ⟨ l ⟩ ∃ F ▹ G ≡ ∃ H ▹ E ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [U∃]
∃-congᵗᵛ {F} {G} {H} {E} {l∃ = ¹} {Γ}
         [Γ] [F] [H] [UG] [UE] [F]ₜ [G]ₜ [H]ₜ [E]ₜ [F≡H]ₜ [G≡E]ₜ {Δ} {σ} ⊢Δ [σ] =
  let l = ∞
      l∃ = ¹
      l∃≤ = ≡is≤ PE.refl
      [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      [∃FG]ᵗ = ∃ᵗᵛ₁ {F} {G} {l∃ = ¹} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [F]ₜ [G]ₜ {Δ = Δ} {σ = σ} ⊢Δ [σ]
      [∃HE]ᵗ = ∃ᵗᵛ₁ {H} {E} {l∃ = ¹} {Γ} [Γ] [H] (λ {Δ} {σ} → [UE] {Δ} {σ}) [H]ₜ [E]ₜ {Δ = Δ} {σ = σ} ⊢Δ [σ]
      ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
      [liftσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
      univΔ = proj₁ ([UF] ⊢Δ [σ])
      [G] = maybeEmbᵛ {A = G} (_∙_ {A = F} [Γ] [F]) (univᵛ {G} (_∙_ {A = F} [Γ] [F]) l∃≤ (λ {Δ} {σ} → [UG] {Δ} {σ}) [G]ₜ)
      [E] = maybeEmbᵛ {A = E} (_∙_ {A = H} [Γ] [H]) (univᵛ {E} (_∙_ {A = H} [Γ] [H]) l∃≤ (λ {Δ} {σ} → [UE] {Δ} {σ}) [E]ₜ)
      [F≡H] = univEqᵛ {F} {H} [Γ] [UF] [F] [F≡H]ₜ
      [G≡E] = univEqᵛ {G} {E} (_∙_ {A = F} [Γ] [F]) (λ {Δ} {σ} → [UG] {Δ} {σ}) [G] [G≡E]ₜ
  in Uₜ₌ [∃FG]ᵗ [∃HE]ᵗ (≅ₜ-∃-cong ⊢F (escapeTermEq univΔ ([F≡H]ₜ ⊢Δ [σ]))
                                    (escapeTermEq (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ]))
                                          ([G≡E]ₜ (⊢Δ ∙ ⊢F) [liftσ])))
         λ {ρ} {Δ₁} [ρ] ⊢Δ₁ → let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                                  X = ∃-congᵛ {F} {G} {H} {E} {Γ} {¹} [Γ] [F] [G] [H] [E] [F≡H] [G≡E] ⊢Δ₁ [ρσ]
                              in irrelevanceEq″ (PE.sym (wk-subst (∃ F ▹ G)))
                                                (PE.sym (wk-subst (∃ H ▹ E))) PE.refl PE.refl
                                                (proj₁ (∃ᵛ {F} {G} [Γ] [F] [G] ⊢Δ₁ [ρσ])) (LogRel._⊩¹U_∷_^_/_.[t] [∃FG]ᵗ [ρ] ⊢Δ₁) X
∃-congᵗᵛ {F} {G} {H} {E} {l∃ = ⁰} {Γ}
         [Γ] [F] [H] [UG] [UE] [F]ₜ [G]ₜ [H]ₜ [E]ₜ [F≡H]ₜ [G≡E]ₜ {Δ} {σ} ⊢Δ [σ] =
  let l = ∞
      l∃ = ⁰
      l∃≤ = ≡is≤ PE.refl
      [UF] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      [∃FG]ᵗ = ∃ᵗᵛ₁ {F} {G} {l∃ = ⁰} {Γ} [Γ] [F] (λ {Δ} {σ} → [UG] {Δ} {σ}) [F]ₜ [G]ₜ {Δ = Δ} {σ = σ} ⊢Δ [σ]
      [∃HE]ᵗ = ∃ᵗᵛ₁ {H} {E} {l∃ = ⁰} {Γ} [Γ] [H] (λ {Δ} {σ} → [UE] {Δ} {σ}) [H]ₜ [E]ₜ {Δ = Δ} {σ = σ} ⊢Δ [σ]
      ⊢F = escape (proj₁ ([F] ⊢Δ [σ]))
      [liftσ] = liftSubstS {F = F} [Γ] ⊢Δ [F] [σ]
      univΔ = proj₁ ([UF] ⊢Δ [σ])
      [Fₜ]σ {σ′} [σ′] = [F]ₜ {σ = σ′} ⊢Δ [σ′]
      [σF] = proj₁ ([Fₜ]σ [σ])
      [G] = maybeEmbᵛ {A = G} (_∙_ {A = F} [Γ] [F]) (univᵛ {G} (_∙_ {A = F} [Γ] [F]) l∃≤ (λ {Δ} {σ} → [UG] {Δ} {σ}) [G]ₜ)
      [E] = maybeEmbᵛ {A = E} (_∙_ {A = H} [Γ] [H]) (univᵛ {E} (_∙_ {A = H} [Γ] [H]) l∃≤ (λ {Δ} {σ} → [UE] {Δ} {σ}) [E]ₜ)
      [F≡H] = univEqᵛ {F} {H} [Γ] [UF] [F] [F≡H]ₜ
      [G≡E] = univEqᵛ {G} {E} (_∙_ {A = F} [Γ] [F]) (λ {Δ} {σ} → [UG] {Δ} {σ}) [G] [G≡E]ₜ
  in Uₜ₌ [∃FG]ᵗ [∃HE]ᵗ (≅ₜ-∃-cong ⊢F (escapeTermEq univΔ ([F≡H]ₜ ⊢Δ [σ]))
                                    (escapeTermEq (proj₁ ([UG] (⊢Δ ∙ ⊢F) [liftσ]))
                                          ([G≡E]ₜ (⊢Δ ∙ ⊢F) [liftσ])))
         λ {ρ} {Δ₁} [ρ] ⊢Δ₁ → let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ [ρ] [σ]
                                  X = ∃-congᵛ {F} {G} {H} {E} {Γ} {⁰} [Γ] [F] [G] [H] [E] [F≡H] [G≡E] ⊢Δ₁ [ρσ]
                              in irrelevanceEq″ (PE.sym (wk-subst (∃ F ▹ G)))
                                                (PE.sym (wk-subst (∃ H ▹ E))) PE.refl PE.refl
                                                (proj₁ (∃ᵛ {F} {G} [Γ] [F] [G] ⊢Δ₁ [ρσ])) (LogRel._⊩¹U_∷_^_/_.[t] [∃FG]ᵗ [ρ] ⊢Δ₁) X

-- Validity of non-dependent sum types.
××ᵛ : ∀ {F G l∃ Γ l}
      ([Γ] : ⊩ᵛ Γ)
      ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
    → Γ ⊩ᵛ⟨ l ⟩ G ^ [ % , ι l∃ ] / [Γ]
    → Γ ⊩ᵛ⟨ l ⟩ F ×× G ^ [ % , ι l∃ ] / [Γ]
××ᵛ {F} {G} [Γ] [F] [G] =
  ∃ᵛ {F} {wk1 G} [Γ] [F] (wk1ᵛ {G} {F} [Γ] [F] [G])

-- Validity of non-dependent sum type congurence.
××-congᵛ : ∀ {F F′ G G′ l∃ Γ l}
           ([Γ] : ⊩ᵛ Γ)
           ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
           ([F′] : Γ ⊩ᵛ⟨ l ⟩ F′ ^ [ % , ι l∃ ] / [Γ])
           ([F≡F′] : Γ ⊩ᵛ⟨ l ⟩ F ≡ F′ ^ [ % , ι l∃ ] / [Γ] / [F])
           ([G] : Γ ⊩ᵛ⟨ l ⟩ G ^ [ % , ι l∃ ] / [Γ])
           ([G′] : Γ ⊩ᵛ⟨ l ⟩ G′ ^ [ % , ι l∃ ] / [Γ])
           ([G≡G′] : Γ ⊩ᵛ⟨ l ⟩ G ≡ G′ ^ [ % , ι l∃ ] / [Γ] / [G])
         → Γ ⊩ᵛ⟨ l ⟩ F ×× G ≡ F′ ×× G′ ^ [ % , ι l∃ ] / [Γ] / ××ᵛ {F} {G} [Γ] [F] [G]
××-congᵛ {F} {F′} {G} {G′} [Γ] [F] [F′] [F≡F′] [G] [G′] [G≡G′] =
  ∃-congᵛ {F} {wk1 G} {F′} {wk1 G′} [Γ]
          [F] (wk1ᵛ {G} {F} [Γ] [F] [G])
          [F′] (wk1ᵛ {G′} {F′} [Γ] [F′] [G′])
          [F≡F′] (wk1Eqᵛ {G} {G′} {F} [Γ] [F] [G] [G≡G′])

××ᵗᵛ : ∀ {F G l∃ Γ} ([Γ] : ⊩ᵛ Γ)→
      let l    = ∞
          [U] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      in
        ([F] : Γ ⊩ᵛ⟨ l ⟩ F ^ [ % , ι l∃ ] / [Γ])
      → Γ ⊩ᵛ⟨ l ⟩ F ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [U]
      → Γ ⊩ᵛ⟨ l ⟩ G ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / (λ {Δ} {σ} → [U] {Δ} {σ})
      → Γ ⊩ᵛ⟨ l ⟩ F ×× G ∷ Univ % l∃ ^ [ ! , next l∃ ] / [Γ] / [U]
××ᵗᵛ {F} {G} {l∃} [Γ] [F] [Fₜ] [Gₜ] =
  let l    = ∞
      [U] = maybeEmbᵛ {A = Univ % _} [Γ] (Uᵛ (proj₂ (levelBounded l∃)) [Γ])
      [Gₜ]′ = wk1ᵗᵛ {F} {G} {[ % , ι l∃ ]} {%} {l∃} [Γ] [F] [Gₜ]
      [wU] = maybeEmbᵛ {A = Univ % _} (_∙_ {A = F} [Γ] [F]) (λ {Δ} {σ} → Uᵛ (proj₂ (levelBounded l∃)) (_∙_ {A = F} [Γ] [F]) {Δ} {σ})
      [wU]′ = wk1ᵛ {Univ _ _ } {F} [Γ] [F] [U]
  in ∃ᵗᵛ {F} {wk1 G} [Γ] [F] (λ {Δ} {σ} → [wU]′ {Δ} {σ}) [Fₜ]
        (S.irrelevanceTerm {A = Univ _ _} {t = wk1 G} (_∙_ {A = F} [Γ] [F]) (_∙_ {A = F} [Γ] [F])
                                                      (λ {Δ} {σ} → [wU] {Δ} {σ}) (λ {Δ} {σ} → [wU]′ {Δ} {σ}) [Gₜ]′)