{-# OPTIONS --rewriting #-}

module Properties.TypeCheck where

open import Agda.Builtin.Equality using (_≡_; refl)
open import Agda.Builtin.Bool using (Bool; true; false)
open import FFI.Data.Maybe using (Maybe; just; nothing)
open import FFI.Data.Either using (Either)
open import Luau.TypeCheck using (_⊢ᴱ_∈_; _⊢ᴮ_∈_; ⊢ᴼ_; ⊢ᴴ_; _⊢ᴴᴱ_▷_∈_; _⊢ᴴᴮ_▷_∈_; nil; var; addr; number; bool; string; app; function; block; binexp; done; return; local; nothing; orUnknown; tgtBinOp)
open import Luau.Syntax using (Block; Expr; Value; BinaryOperator; yes; nil; addr; number; bool; string; val; var; binexp; _$_; function_is_end; block_is_end; _∙_; return; done; local_←_; _⟨_⟩; _⟨_⟩∈_; var_∈_; name; fun; arg; +; -; *; /; <; >; ==; ~=; <=; >=)
open import Luau.Type using (Type; nil; unknown; never; number; boolean; string; _⇒_; src; tgt)
open import Luau.RuntimeType using (RuntimeType; nil; number; function; string; valueType)
open import Luau.VarCtxt using (VarCtxt; ∅; _↦_; _⊕_↦_; _⋒_; _⊝_) renaming (_[_] to _[_]ⱽ)
open import Luau.Addr using (Addr)
open import Luau.Var using (Var; _≡ⱽ_)
open import Luau.Heap using (Heap; Object; function_is_end) renaming (_[_] to _[_]ᴴ)
open import Properties.Contradiction using (CONTRADICTION)
open import Properties.Dec using (yes; no)
open import Properties.Equality using (_≢_; sym; trans; cong)
open import Properties.Product using (_×_; _,_)
open import Properties.Remember using (Remember; remember; _,_)

typeOfᴼ : Object yes → Type
typeOfᴼ (function f ⟨ var x ∈ S ⟩∈ T is B end) = (S ⇒ T)

typeOfᴹᴼ : Maybe(Object yes) → Maybe Type
typeOfᴹᴼ nothing = nothing
typeOfᴹᴼ (just O) = just (typeOfᴼ O)

typeOfⱽ : Heap yes → Value → Maybe Type
typeOfⱽ H nil = just nil
typeOfⱽ H (bool b) = just boolean
typeOfⱽ H (addr a) = typeOfᴹᴼ (H [ a ]ᴴ)
typeOfⱽ H (number n) = just number
typeOfⱽ H (string x) = just string

typeOfᴱ : Heap yes → VarCtxt → (Expr yes) → Type
typeOfᴮ : Heap yes → VarCtxt → (Block yes) → Type

typeOfᴱ H Γ (var x) = orUnknown(Γ [ x ]ⱽ)
typeOfᴱ H Γ (val v) = orUnknown(typeOfⱽ H v)
typeOfᴱ H Γ (M $ N) = tgt(typeOfᴱ H Γ M)
typeOfᴱ H Γ (function f ⟨ var x ∈ S ⟩∈ T is B end) = S ⇒ T
typeOfᴱ H Γ (block var b ∈ T is B end) = T
typeOfᴱ H Γ (binexp M op N) = tgtBinOp op

typeOfᴮ H Γ (function f ⟨ var x ∈ S ⟩∈ T is C end ∙ B) = typeOfᴮ H (Γ ⊕ f ↦ (S ⇒ T)) B
typeOfᴮ H Γ (local var x ∈ T ← M ∙ B) = typeOfᴮ H (Γ ⊕ x ↦ T) B
typeOfᴮ H Γ (return M ∙ B) = typeOfᴱ H Γ M
typeOfᴮ H Γ done = nil

mustBeFunction : ∀ H Γ v → (never ≢ src (typeOfᴱ H Γ (val v))) → (function ≡ valueType(v))
mustBeFunction H Γ nil p = CONTRADICTION (p refl)
mustBeFunction H Γ (addr a) p = refl
mustBeFunction H Γ (number n) p = CONTRADICTION (p refl)
mustBeFunction H Γ (bool true) p = CONTRADICTION (p refl)
mustBeFunction H Γ (bool false) p = CONTRADICTION (p refl)
mustBeFunction H Γ (string x) p = CONTRADICTION (p refl)

mustBeNumber : ∀ H Γ v → (typeOfᴱ H Γ (val v) ≡ number) → (valueType(v) ≡ number)
mustBeNumber H Γ (addr a) p with remember (H [ a ]ᴴ)
mustBeNumber H Γ (addr a) p | (just O , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
mustBeNumber H Γ (addr a) p | (just function f ⟨ var x ∈ T ⟩∈ U is B end , q) | ()
mustBeNumber H Γ (addr a) p | (nothing , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
mustBeNumber H Γ (addr a) p | nothing , q | ()
mustBeNumber H Γ (number n) p = refl

mustBeString : ∀ H Γ v → (typeOfᴱ H Γ (val v) ≡ string) → (valueType(v) ≡ string)
mustBeString H Γ (addr a) p with remember (H [ a ]ᴴ)
mustBeString H Γ (addr a) p | (just O , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
mustBeString H Γ (addr a) p | (just function f ⟨ var x ∈ T ⟩∈ U is B end , q) | ()
mustBeString H Γ (addr a) p | (nothing , q) with trans (cong orUnknown (cong typeOfᴹᴼ (sym q))) p
mustBeString H Γ (addr a) p | (nothing , q) | ()
mustBeString H Γ (string x) p = refl

typeCheckᴱ : ∀ H Γ M → (Γ ⊢ᴱ M ∈ (typeOfᴱ H Γ M))
typeCheckᴮ : ∀ H Γ B → (Γ ⊢ᴮ B ∈ (typeOfᴮ H Γ B))

typeCheckᴱ H Γ (var x) = var refl
typeCheckᴱ H Γ (val nil) = nil
typeCheckᴱ H Γ (val (addr a)) = addr (orUnknown (typeOfᴹᴼ (H [ a ]ᴴ)))
typeCheckᴱ H Γ (val (number n)) = number
typeCheckᴱ H Γ (val (bool b)) = bool
typeCheckᴱ H Γ (val (string x)) = string
typeCheckᴱ H Γ (M $ N) = app (typeCheckᴱ H Γ M) (typeCheckᴱ H Γ N)
typeCheckᴱ H Γ (function f ⟨ var x ∈ T ⟩∈ U is B end) = function (typeCheckᴮ H (Γ ⊕ x ↦ T) B)
typeCheckᴱ H Γ (block var b ∈ T is B end) = block (typeCheckᴮ H Γ B)
typeCheckᴱ H Γ (binexp M op N) = binexp (typeCheckᴱ H Γ M) (typeCheckᴱ H Γ N)

typeCheckᴮ H Γ (function f ⟨ var x ∈ T ⟩∈ U is C end ∙ B) = function (typeCheckᴮ H (Γ ⊕ x ↦ T) C) (typeCheckᴮ H (Γ ⊕ f ↦ (T ⇒ U)) B)
typeCheckᴮ H Γ (local var x ∈ T ← M ∙ B) = local (typeCheckᴱ H Γ M) (typeCheckᴮ H (Γ ⊕ x ↦ T) B)
typeCheckᴮ H Γ (return M ∙ B) = return (typeCheckᴱ H Γ M) (typeCheckᴮ H Γ B)
typeCheckᴮ H Γ done = done

typeCheckᴼ : ∀ H O → (⊢ᴼ O)
typeCheckᴼ H nothing = nothing
typeCheckᴼ H (just function f ⟨ var x ∈ T ⟩∈ U is B end) = function (typeCheckᴮ H (x ↦ T) B)

typeCheckᴴ : ∀ H → (⊢ᴴ H)
typeCheckᴴ H a {O} p = typeCheckᴼ H (O)

typeCheckᴴᴱ : ∀ H Γ M → (Γ ⊢ᴴᴱ H ▷ M ∈ typeOfᴱ H Γ M)
typeCheckᴴᴱ H Γ M = (typeCheckᴴ H , typeCheckᴱ H Γ M)

typeCheckᴴᴮ : ∀ H Γ M → (Γ ⊢ᴴᴮ H ▷ M ∈ typeOfᴮ H Γ M)
typeCheckᴴᴮ H Γ M = (typeCheckᴴ H , typeCheckᴮ H Γ M)


{-# OPTIONS --safe #-}

module Definition.Typed.Consequences.Canonicity where

open import Definition.Untyped

open import Definition.Typed
open import Definition.Typed.Weakening
open import Definition.Typed.Properties
open import Definition.Typed.EqRelInstance
open import Definition.LogicalRelation
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Fundamental.Reducibility

open import Tools.Empty
open import Tools.Nat
open import Tools.Product

-- Turns a natural number into its term representation
sucᵏ : Nat → Term
sucᵏ 0 = zero
sucᵏ (1+ n) = suc (sucᵏ n)

-- No neutral terms are well-formed in an empty context

-- we need to postulate consistency
-- as we have several uninhabited propositions, we build an predicate
-- to characterize them

-- Note that we could also have defined reductions to Empty of other
-- forms of unihabited types

data isFalse : Term → Set where
  isEmpty : ∀ {lEmpty} → isFalse (Empty lEmpty)
  isIdℕΠ : ∀ {r A rA B} → isFalse (Id (Univ r ⁰) ℕ (Π A ^ rA ° ⁰ ▹ B ° ⁰ ° ⁰))
  isIdΠℕ : ∀ {r A rA B} → isFalse (Id (Univ r ⁰) (Π A ^ rA ° ⁰ ▹ B ° ⁰ ° ⁰) ℕ)
  isIdΠΠ%! : ∀ {r A B A' B'} → isFalse (Id (Univ r ⁰) (Π A ^ % ° ⁰ ▹ B ° ⁰ ° ⁰) (Π A' ^ ! ° ⁰ ▹ B' ° ⁰ ° ⁰))
  isIdΠΠ!% : ∀ {r A B A' B'} → isFalse (Id (Univ r ⁰) (Π A ^ ! ° ⁰ ▹ B ° ⁰ ° ⁰) (Π A' ^ % ° ⁰ ▹ B' ° ⁰ ° ⁰))

consistency = ∀ {t A l} → isFalse A → ε ⊢ t ∷ A ^ [ % , l ] → ⊥

noNe : ∀ {t A r} → consistency → ε ⊢ t ∷ A ^ r → Neutral t → ⊥

-- impossible cases thanks to consistency
noNe consistency (Emptyrecⱼ A ⊢e) Emptyrecₙ = consistency isEmpty ⊢e
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) castℕΠₙ = consistency isIdℕΠ [A]₂
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) castΠℕₙ = consistency isIdΠℕ [A]₂
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) castΠΠ%!ₙ = consistency isIdΠΠ%! [A]₂
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) castΠΠ!%ₙ = consistency isIdΠΠ!% [A]₂

-- possible cases proven by induction
noNe consistency (⊢t ∘ⱼ ⊢t₁) (∘ₙ neT) = noNe consistency  ⊢t neT
noNe consistency (natrecⱼ x ⊢t ⊢t₁ ⊢t₂) (natrecₙ neT) = noNe consistency ⊢t₂ neT
noNe consistency (var x₁ ()) (var x)
noNe consistency (Idⱼ [A] [A]₁ [A]₂) (Idₙ neT) = noNe consistency [A] neT
noNe consistency (Idⱼ [A] [A]₁ [A]₂) (Idℕₙ neT) = noNe consistency [A]₁ neT
noNe consistency (Idⱼ [A] [A]₁ [A]₂) (Idℕ0ₙ neT) = noNe consistency [A]₂ neT
noNe consistency (Idⱼ [A] [A]₁ [A]₂) (IdℕSₙ neT) = noNe consistency [A]₂ neT
noNe consistency (Idⱼ [A] [A]₁ [A]₂) (IdUₙ neT) = noNe consistency [A]₁ neT
noNe consistency (Idⱼ [A] [A]₁ [A]₂) (IdUℕₙ neT) = noNe consistency [A]₂ neT
noNe consistency (Idⱼ [A] [A]₁ [A]₂) (IdUΠₙ neT) = noNe consistency [A]₂ neT
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) (castₙ neT) = noNe consistency [A] neT
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) (castℕₙ neT) = noNe consistency [A]₁ neT
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) (castΠₙ neT) = noNe consistency [A]₁ neT
noNe consistency (castⱼ [A] [A]₁ [A]₂ [A]₃) (castℕℕₙ neT) = noNe consistency [A]₃ neT
noNe consistency (conv ⊢t x) (var n) = noNe consistency ⊢t (var n)
noNe consistency (conv ⊢t x) (∘ₙ neT) = noNe consistency ⊢t (∘ₙ neT)
noNe consistency (conv ⊢t x) (natrecₙ neT) = noNe consistency ⊢t (natrecₙ neT)
noNe consistency (conv ⊢t x) (Idₙ neT) = noNe consistency ⊢t (Idₙ neT)
noNe consistency (conv ⊢t x) (Idℕₙ neT) = noNe consistency ⊢t (Idℕₙ neT)
noNe consistency (conv ⊢t x) (Idℕ0ₙ neT) = noNe consistency ⊢t (Idℕ0ₙ neT)
noNe consistency (conv ⊢t x) (IdℕSₙ neT) = noNe consistency ⊢t (IdℕSₙ neT)
noNe consistency (conv ⊢t x) (IdUₙ neT) = noNe consistency ⊢t (IdUₙ neT)
noNe consistency (conv ⊢t x) (IdUℕₙ neT) = noNe consistency ⊢t (IdUℕₙ neT)
noNe consistency (conv ⊢t x) (IdUΠₙ neT) = noNe consistency ⊢t (IdUΠₙ neT)
noNe consistency (conv ⊢t x) (castₙ neT) = noNe consistency ⊢t (castₙ neT)
noNe consistency (conv ⊢t x) (castℕₙ neT) = noNe consistency ⊢t (castℕₙ neT)
noNe consistency (conv ⊢t x) (castΠₙ neT) = noNe consistency ⊢t (castΠₙ neT)
noNe consistency (conv ⊢t x) (castℕℕₙ neT) = noNe consistency ⊢t (castℕℕₙ neT)
noNe consistency (conv ⊢t x) castℕΠₙ = noNe consistency ⊢t castℕΠₙ
noNe consistency (conv ⊢t x) castΠℕₙ = noNe consistency ⊢t castΠℕₙ
noNe consistency (conv ⊢t x) castΠΠ%!ₙ = noNe consistency ⊢t castΠΠ%!ₙ
noNe consistency (conv ⊢t x) castΠΠ!%ₙ = noNe consistency ⊢t castΠΠ!%ₙ
noNe consistency (conv ⊢t x) Emptyrecₙ = noNe consistency ⊢t Emptyrecₙ

-- Helper function for canonicity for reducible natural properties
canonicity″ : ∀ {t}
              → consistency
              → Natural-prop ε t
              → ∃ λ k → ε ⊢ t ≡ sucᵏ k ∷ ℕ ^ [ ! , ι ⁰ ]
canonicity″ consistency (sucᵣ (ℕₜ n₁ d n≡n prop)) =
  let a , b = canonicity″ consistency prop
  in  1+ a , suc-cong (trans (subset*Term (redₜ d)) b)
canonicity″ consistency zeroᵣ = 0 , refl (zeroⱼ ε)
canonicity″ consistency (ne (neNfₜ neK ⊢k k≡k)) = ⊥-elim (noNe consistency ⊢k neK)

-- Helper function for canonicity for specific reducible natural numbers
canonicity′ : ∀ {t l}
             → consistency
             → ([ℕ] : ε ⊩⟨ l ⟩ℕ ℕ)
             → ε ⊩⟨ l ⟩ t ∷ ℕ ^ [ ! , ι ⁰ ] / ℕ-intr [ℕ]
             → ∃ λ k → ε ⊢ t ≡ sucᵏ k ∷ ℕ ^ [ ! , ι ⁰ ]
canonicity′ consistency (noemb [ℕ]) (ℕₜ n d n≡n prop) = let a , b = canonicity″ consistency prop
                                          in  a , trans (subset*Term (redₜ d)) b
canonicity′ consistency (emb emb< [ℕ]) [t] = canonicity′ consistency [ℕ] [t]
canonicity′ consistency (emb ∞< [ℕ]) [t] = canonicity′ consistency [ℕ] [t]

-- Canonicity of natural numbers
canonicity : ∀ {t} →
             consistency →
             ε ⊢ t ∷ ℕ ^ [ ! , ι ⁰ ] →
             ∃ λ k → ε ⊢ t ≡ sucᵏ k ∷ ℕ ^ [ ! , ι ⁰ ]
canonicity consistency ⊢t with reducibleTerm ⊢t
canonicity consistency ⊢t | [ℕ] , [t] =
  canonicity′ consistency (ℕ-elim [ℕ]) (irrelevanceTerm [ℕ] (ℕ-intr (ℕ-elim [ℕ])) [t])


{-# OPTIONS --rewriting --confluence-check #-}

open import Agda.Builtin.Equality
open import Agda.Builtin.Equality.Rewrite

record Box (A : Set) : Set where
  constructor box
  field
    unbox : A
open Box

postulate
  A : Set
  a b : A

  f : (X : Set) → X → A
  g : (X : Set) → X

  rewf₁ : f (Box A) (box a) ≡ a
  rewf₂ : (X : Set) → f X (g X) ≡ b

  rewg : g (Box A) .unbox ≡ a

test = f (Box A) (g (Box A))

{-# REWRITE rewf₁ rewg #-}

rewg-contracted : g (Box A) ≡ box a
rewg-contracted = refl

foo : test ≡ a
foo = refl

{-# REWRITE rewf₂ #-}

bar : test ≡ b
bar = refl

fails : a ≡ b
fails = refl


module STLC1.Kovacs.Soundness where

open import STLC1.Kovacs.Convertibility public
open import STLC1.Kovacs.PresheafRefinement public

--------------------------------------------------------------------------------

infix 3 _≈_
_≈_ : ∀ {A Γ} → Γ ⊩ A → Γ ⊩ A → Set

_≈_ {⎵}      {Γ} M₁ M₂ = M₁ ≡ M₂

_≈_ {A ⇒ B} {Γ} f₁ f₂ = ∀ {Γ′} → (η : Γ′ ⊇ Γ) {a₁ a₂ : Γ′ ⊩ A}
                                → (p : a₁ ≈ a₂) (u₁ : 𝒰 a₁) (u₂ : 𝒰 a₂)
                                → f₁ η a₁ ≈ f₂ η a₂

_≈_ {A ⩕ B}  {Γ} s₁ s₂ = proj₁ s₁ ≈ proj₁ s₂ × proj₂ s₁ ≈ proj₂ s₂

_≈_ {⫪}     {Γ} s₁ s₂ = ⊤

-- (≈ᶜ ; ∙ ; _,_)
infix 3 _≈⋆_
data _≈⋆_ : ∀ {Γ Ξ} → Γ ⊩⋆ Ξ → Γ ⊩⋆ Ξ → Set
  where
    ∅   : ∀ {Γ} → ∅ {Γ} ≈⋆ ∅

    _,_ : ∀ {Γ Ξ A} → {ρ₁ ρ₂ : Γ ⊩⋆ Ξ} {M₁ M₂ : Γ ⊩ A}
                    → (χ : ρ₁ ≈⋆ ρ₂) (p : M₁ ≈ M₂)
                    → ρ₁ , M₁ ≈⋆ ρ₂ , M₂

-- (_≈⁻¹)
_⁻¹≈ : ∀ {A Γ} → {a₁ a₂ : Γ ⊩ A}
               → a₁ ≈ a₂
               → a₂ ≈ a₁
_⁻¹≈ {⎵}      p = p ⁻¹
_⁻¹≈ {A ⇒ B} F = λ η p u₁ u₂ →
                    F η (p ⁻¹≈) u₂ u₁ ⁻¹≈
_⁻¹≈ {A ⩕ B}  p = proj₁ p ⁻¹≈ , proj₂ p ⁻¹≈
_⁻¹≈ {⫪}     p = tt

-- (_≈ᶜ⁻¹)
_⁻¹≈⋆ : ∀ {Γ Ξ} → {ρ₁ ρ₂ : Γ ⊩⋆ Ξ}
                → ρ₁ ≈⋆ ρ₂
                → ρ₂ ≈⋆ ρ₁
∅       ⁻¹≈⋆ = ∅
(χ , p) ⁻¹≈⋆ = χ ⁻¹≈⋆ , p ⁻¹≈

-- (_≈◾_)
_⦙≈_ : ∀ {A Γ} → {a₁ a₂ a₃ : Γ ⊩ A}
               → a₁ ≈ a₂ → a₂ ≈ a₃
               → a₁ ≈ a₃
_⦙≈_ {⎵}      p q = p ⦙ q
_⦙≈_ {A ⇒ B} F G = λ η p u₁ u₂ →
                       F η (p ⦙≈ (p ⁻¹≈)) u₁ u₁
                    ⦙≈ G η p u₁ u₂
_⦙≈_ {A ⩕ B}  p q = proj₁ p ⦙≈ proj₁ q , proj₂ p ⦙≈ proj₂ q
_⦙≈_ {⫪}     p q = tt

-- (_≈ᶜ◾_)
_⦙≈⋆_ : ∀ {Γ Ξ} → {ρ₁ ρ₂ ρ₃ : Γ ⊩⋆ Ξ}
                → ρ₁ ≈⋆ ρ₂ → ρ₂ ≈⋆ ρ₃
                → ρ₁ ≈⋆ ρ₃
∅        ⦙≈⋆ ∅        = ∅
(χ₁ , p) ⦙≈⋆ (χ₂ , q) = χ₁ ⦙≈⋆ χ₂ , p ⦙≈ q

instance
  per≈ : ∀ {Γ A} → PER (Γ ⊩ A) _≈_
  per≈ =
    record
      { _⁻¹ = _⁻¹≈
      ; _⦙_ = _⦙≈_
      }

instance
  per≈⋆ : ∀ {Γ Ξ} → PER (Γ ⊩⋆ Ξ) _≈⋆_
  per≈⋆ =
    record
      { _⁻¹ = _⁻¹≈⋆
      ; _⦙_ = _⦙≈⋆_
      }

--------------------------------------------------------------------------------

-- (≈ₑ)
acc≈ : ∀ {A Γ Γ′} → {a₁ a₂ : Γ ⊩ A}
                  → (η : Γ′ ⊇ Γ) → a₁ ≈ a₂
                  → acc η a₁ ≈ acc η a₂
acc≈ {⎵}      η p = renⁿᶠ η & p
acc≈ {A ⇒ B} η F = λ η′ → F (η ○ η′)
acc≈ {A ⩕ B}  η p = acc≈ η (proj₁ p) , acc≈ η (proj₂ p)
acc≈ {⫪}     η p = tt

-- (≈ᶜₑ)
_⬖≈_ : ∀ {Γ Γ′ Ξ} → {ρ₁ ρ₂ : Γ ⊩⋆ Ξ}
                  → ρ₁ ≈⋆ ρ₂ → (η : Γ′ ⊇ Γ)
                  → ρ₁ ⬖ η ≈⋆ ρ₂ ⬖ η
∅       ⬖≈ η = ∅
(χ , p) ⬖≈ η = χ ⬖≈ η , acc≈ η p

-- (∈≈)
get≈ : ∀ {Γ Ξ A} → {ρ₁ ρ₂ : Γ ⊩⋆ Ξ}
                 → ρ₁ ≈⋆ ρ₂ → (i : Ξ ∋ A)
                 → getᵥ ρ₁ i ≈ getᵥ ρ₂ i
get≈ (χ , p) zero    = p
get≈ (χ , p) (suc i) = get≈ χ i

-- (Tm≈)
eval≈ : ∀ {Γ Ξ A} → {ρ₁ ρ₂ : Γ ⊩⋆ Ξ}
                  → ρ₁ ≈⋆ ρ₂ → 𝒰⋆ ρ₁ → 𝒰⋆ ρ₂ → (M : Ξ ⊢ A)
                  → eval ρ₁ M ≈ eval ρ₂ M
eval≈ χ υ₁ υ₂ (𝓋 i)   = get≈ χ i
eval≈ χ υ₁ υ₂ (ƛ M)   = λ η p u₁ u₂ →
                          eval≈ (χ ⬖≈ η , p)
                                (υ₁ ⬖𝒰 η , u₁)
                                (υ₂ ⬖𝒰 η , u₂)
                                M
eval≈ χ υ₁ υ₂ (M ∙ N) = eval≈ χ υ₁ υ₂ M idₑ
                              (eval≈ χ υ₁ υ₂ N)
                              (eval𝒰 υ₁ N)
                              (eval𝒰 υ₂ N)
eval≈ χ υ₁ υ₂ (M , N) = eval≈ χ υ₁ υ₂ M , eval≈ χ υ₁ υ₂ N
eval≈ χ υ₁ υ₂ (π₁ M)  = proj₁ (eval≈ χ υ₁ υ₂ M)
eval≈ χ υ₁ υ₂ (π₂ M)  = proj₂ (eval≈ χ υ₁ υ₂ M)
eval≈ χ υ₁ υ₂ τ       = tt

--------------------------------------------------------------------------------

-- (Subᴺᴾ)
-- NOTE: _◆𝒰_ = eval𝒰⋆
_◆𝒰_ : ∀ {Γ Ξ Φ} → {ρ : Γ ⊩⋆ Ξ}
                 → (σ : Ξ ⊢⋆ Φ) → 𝒰⋆ ρ
                 → 𝒰⋆ (σ ◆ ρ)
∅       ◆𝒰 υ = ∅
(σ , M) ◆𝒰 υ = σ ◆𝒰 υ , eval𝒰 υ M

-- (Subᴺ≈ᶜ)
-- NOTE: _◆≈_ = eval≈⋆
_◆≈_ : ∀ {Γ Ξ Φ} → {ρ₁ ρ₂ : Γ ⊩⋆ Ξ}
                 → (σ : Ξ ⊢⋆ Φ) → ρ₁ ≈⋆ ρ₂ → 𝒰⋆ ρ₁ → 𝒰⋆ ρ₂
                 → σ ◆ ρ₁ ≈⋆ σ ◆ ρ₂
(∅ ◆≈ χ)       υ₁ υ₂ = ∅
((σ , M) ◆≈ χ) υ₁ υ₂ = (σ ◆≈ χ) υ₁ υ₂ , eval≈ χ υ₁ υ₂ M

--------------------------------------------------------------------------------

-- (Tmₛᴺ)
eval◆ : ∀ {Γ Ξ Φ A} → {ρ : Γ ⊩⋆ Ξ}
                    → ρ ≈⋆ ρ → 𝒰⋆ ρ → (σ : Ξ ⊢⋆ Φ) (M : Φ ⊢ A)
                    → eval ρ (sub σ M) ≈ eval (σ ◆ ρ) M

eval◆ {ρ = ρ} χ υ σ (𝓋 i)
  rewrite get◆ ρ σ i
  = eval≈ χ υ υ (getₛ σ i)

eval◆ {ρ = ρ} χ υ σ (ƛ M) η {a₁} {a₂} p u₁ u₂
  rewrite comp◆⬖ η υ σ
  = let
      υ′ = υ ⬖𝒰 η
    in
      eval◆ {ρ = ρ ⬖ η , a₁}
            ((χ ⬖≈ η) , (p ⦙ p ⁻¹))
            (υ ⬖𝒰 η , u₁)
            (liftₛ σ)
            M
    ⦙ coe ((λ ρ′ → eval (ρ′ , a₁) M ≈ _)
           & ( comp◆⬗ (ρ ⬖ η , a₁) (wkₑ idₑ) σ
             ⦙ (σ ◆_) & lid⬗ (ρ ⬖ η)
             ) ⁻¹)
          (eval≈ ((σ ◆≈ (χ ⬖≈ η)) υ′ υ′ , p)
                 (σ ◆𝒰 υ′ , u₁)
                 (σ ◆𝒰 υ′ , u₂)
                 M)

eval◆ {ρ = ρ} χ υ σ (M ∙ N)
  = eval◆ χ υ σ M
          idₑ
          (eval◆ χ υ σ N)
          (eval𝒰 υ (sub σ N))
          (eval𝒰 (σ ◆𝒰 υ) N)

eval◆ {ρ = ρ} χ υ σ (M , N) = eval◆ χ υ σ M , eval◆ χ υ σ N
eval◆ {ρ = ρ} χ υ σ (π₁ M)  = proj₁ (eval◆ χ υ σ M)
eval◆ {ρ = ρ} χ υ σ (π₂ M)  = proj₂ (eval◆ χ υ σ M)
eval◆ {ρ = ρ} χ υ σ τ       = tt

--------------------------------------------------------------------------------

-- (~≈)
eval∼ : ∀ {Γ Ξ A} → {ρ₁ ρ₂ : Γ ⊩⋆ Ξ}
                  → ρ₁ ≈⋆ ρ₂ → 𝒰⋆ ρ₁ → 𝒰⋆ ρ₂
                  → {M₁ M₂ : Ξ ⊢ A}
                  → M₁ ∼ M₂
                  → eval ρ₁ M₁ ≈ eval ρ₂ M₂

eval∼ χ υ₁ υ₂ {M} refl∼ = eval≈ χ υ₁ υ₂ M
eval∼ χ υ₁ υ₂ (p ⁻¹∼)   = eval∼ (χ ⁻¹) υ₂ υ₁ p ⁻¹
eval∼ χ υ₁ υ₂ (p ⦙∼ q)  = eval∼ (χ ⦙ χ ⁻¹) υ₁ υ₁ p
                        ⦙ eval∼ χ υ₁ υ₂ q

eval∼ χ υ₁ υ₂ (ƛ∼ p)
  = λ η q u₁ u₂ →
      eval∼ (χ ⬖≈ η , q)
            (υ₁ ⬖𝒰 η , u₁)
            (υ₂ ⬖𝒰 η , u₂)
            p

eval∼ χ υ₁ υ₂ (_∙∼_ {N₁ = N₁} {N₂} p q)
  = eval∼ χ υ₁ υ₂ p
          idₑ
          (eval∼ χ υ₁ υ₂ q)
          (eval𝒰 υ₁ N₁)
          (eval𝒰 υ₂ N₂)

eval∼ χ υ₁ υ₂ (p ,∼ q) = eval∼ χ υ₁ υ₂ p , eval∼ χ υ₁ υ₂ q
eval∼ χ υ₁ υ₂ (π₁∼ p ) = proj₁ (eval∼ χ υ₁ υ₂ p)
eval∼ χ υ₁ υ₂ (π₂∼ p ) = proj₂ (eval∼ χ υ₁ υ₂ p)

eval∼ {ρ₁ = ρ₁} {ρ₂} χ υ₁ υ₂ (red⇒ M N)
  = coe ((λ ρ₁′ ρ₂′ → eval (ρ₁′ , eval ρ₁ N) M ≈ eval (ρ₂′ , eval ρ₂ N) M)
         & (lid⬖ ρ₁ ⁻¹)
         ⊗ (lid◆ ρ₂ ⁻¹))
        (eval≈ (χ , eval≈ χ υ₁ υ₂ N)
               (υ₁ , eval𝒰 υ₁ N)
               (υ₂ , eval𝒰 υ₂ N)
               M)
  ⦙ eval◆ (χ ⁻¹ ⦙ χ) υ₂ (idₛ , N) M ⁻¹

eval∼ χ υ₁ υ₂ (red⩕₁ M N) = eval≈ χ υ₁ υ₂ M
eval∼ χ υ₁ υ₂ (red⩕₂ M N) = eval≈ χ υ₁ υ₂ N

eval∼ {ρ₂ = ρ₂} χ υ₁ υ₂ (exp⇒ M) η {a₂ = a₂} p u₁ u₂
  rewrite eval⬗ (ρ₂ ⬖ η , a₂) (wkₑ idₑ) M ⁻¹
        | lid⬗ (ρ₂ ⬖ η)
        | eval⬖ η υ₂ M
        | rid○ η
  = eval≈ χ υ₁ υ₂ M η p u₁ u₂

eval∼ χ υ₁ υ₂ (exp⩕ M)  = eval≈ χ υ₁ υ₂ M
eval∼ χ υ₁ υ₂ (exp⫪ M) = tt

--------------------------------------------------------------------------------

mutual
  -- (q≈)
  reify≈ : ∀ {A Γ} → {a₁ a₂ : Γ ⊩ A}
                   → a₁ ≈ a₂
                   → reify a₁ ≡ reify a₂
  reify≈ {⎵}      p = p
  reify≈ {A ⇒ B} F = ƛ & reify≈ (F (wkₑ {A = A} idₑ)
                                    (reflect≈ refl)
                                    (reflect𝒰 {A} 0)
                                    (reflect𝒰 {A} 0))
  reify≈ {A ⩕ B}  p = _,_ & reify≈ (proj₁ p)
                          ⊗ reify≈ (proj₂ p)
  reify≈ {⫪}     p = refl

  -- (u≈)
  reflect≈ : ∀ {A Γ} → {M₁ M₂ : Γ ⊢ⁿᵉ A}
                     → M₁ ≡ M₂
                     → reflect M₁ ≈ reflect M₂
  reflect≈ {⎵}      p = ne & p
  reflect≈ {A ⇒ B} p = λ η q u₁ u₂ →
                          reflect≈ (_∙_ & (renⁿᵉ η & p)
                                        ⊗ reify≈ q)
  reflect≈ {A ⩕ B}  p = reflect≈ (π₁ & p) , reflect≈ (π₂ & p)
  reflect≈ {⫪}     p = tt

-- (uᶜ≈)
id≈ : ∀ {Γ} → idᵥ {Γ} ≈⋆ idᵥ
id≈ {∅}     = ∅
id≈ {Γ , A} = id≈ ⬖≈ wkₑ idₑ , reflect≈ refl

sound : ∀ {Γ A} → {M₁ M₂ : Γ ⊢ A}
                → M₁ ∼ M₂
                → nf M₁ ≡ nf M₂
sound p = reify≈ (eval∼ id≈ id𝒰 id𝒰 p)

--------------------------------------------------------------------------------


module OldBasicILP.UntypedSyntax.Translation where

open import OldBasicILP.UntypedSyntax.Common public

import OldBasicILP.UntypedSyntax.ClosedHilbertSequential as CHS
import OldBasicILP.UntypedSyntax.ClosedHilbert as CH

-- Translation of types parametrised by a closed, untyped representation of syntax.

_↦ᵀ_ : ∀ {Rep Rep′} → (Rep → Rep′) → ClosedSyntax.Ty Rep → ClosedSyntax.Ty Rep′
f ↦ᵀ (ClosedSyntax.α P)   = ClosedSyntax.α P
f ↦ᵀ (A ClosedSyntax.▻ B) = f ↦ᵀ A ClosedSyntax.▻ f ↦ᵀ B
f ↦ᵀ (p ClosedSyntax.⦂ A) = f p ClosedSyntax.⦂ f ↦ᵀ A
f ↦ᵀ (A ClosedSyntax.∧ B) = f ↦ᵀ A ClosedSyntax.∧ f ↦ᵀ B
f ↦ᵀ ClosedSyntax.⊤      = ClosedSyntax.⊤

-- Translation from closed Hilbert-style sequential to closed Hilbert-style.

chsᴿ→chᴿ : ∀ {n} → CHS.Rep n → Fin n → CH.Rep
chsᴿ→chᴿ (CHS.MP i j r) zero    = CH.APP (chsᴿ→chᴿ r i) (chsᴿ→chᴿ r j)
chsᴿ→chᴿ (CHS.CI r)     zero    = CH.CI
chsᴿ→chᴿ (CHS.CK r)     zero    = CH.CK
chsᴿ→chᴿ (CHS.CS r)     zero    = CH.CS
chsᴿ→chᴿ (CHS.NEC `r r) zero    = CH.BOX (chsᴿ→chᴿ `r zero)
chsᴿ→chᴿ (CHS.CDIST r)  zero    = CH.CDIST
chsᴿ→chᴿ (CHS.CUP r)    zero    = CH.CUP
chsᴿ→chᴿ (CHS.CDOWN r)  zero    = CH.CDOWN
chsᴿ→chᴿ (CHS.CPAIR r)  zero    = CH.CPAIR
chsᴿ→chᴿ (CHS.CFST r)   zero    = CH.CFST
chsᴿ→chᴿ (CHS.CSND r)   zero    = CH.CSND
chsᴿ→chᴿ (CHS.UNIT r)   zero    = CH.UNIT
chsᴿ→chᴿ (CHS.MP i j r) (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CI r)     (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CK r)     (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CS r)     (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.NEC `r r) (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CDIST r)  (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CUP r)    (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CDOWN r)  (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CPAIR r)  (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CFST r)   (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.CSND r)   (suc k) = chsᴿ→chᴿ r k
chsᴿ→chᴿ (CHS.UNIT r)   (suc k) = chsᴿ→chᴿ r k

chsᴾ→chᴾ : CHS.Proof → CH.Proof
chsᴾ→chᴾ CHS.[ r ] = CH.[ chsᴿ→chᴿ r zero ]

chsᵀ→chᵀ : CHS.Ty → CH.Ty
chsᵀ→chᵀ = chsᴾ→chᴾ ↦ᵀ_

-- FIXME: What is going on here?
postulate
  ᴬlem₁ : ∀ {n₁ n₂} → (r₁ : CHS.Rep (suc n₁)) → (r₂ : CHS.Rep (suc n₂))
          → chsᴿ→chᴿ (CHS.APP r₁ r₂) zero ≡ CH.APP (chsᴿ→chᴿ r₁ zero) (chsᴿ→chᴿ r₂ zero)

mutual
  chsᴰ→ch : ∀ {Ξ A} → CHS.⊢ᴰ Ξ → A ∈ Ξ → CH.⊢ chsᵀ→chᵀ A
  chsᴰ→ch (CHS.mp i j d)               top     = CH.app (chsᴰ→ch d i) (chsᴰ→ch d j)
  chsᴰ→ch (CHS.ci d)                   top     = CH.ci
  chsᴰ→ch (CHS.ck d)                   top     = CH.ck
  chsᴰ→ch (CHS.cs d)                   top     = CH.cs
  chsᴰ→ch (CHS.nec `d d)               top     rewrite ᴬlem₂ `d top = CH.box (chsᴰ→ch `d top)
  chsᴰ→ch (CHS.cdist {r₁ = r₁} {r₂} d) top     rewrite ᴬlem₁ r₁ r₂  = CH.cdist
  chsᴰ→ch (CHS.cup d)                  top     = CH.cup
  chsᴰ→ch (CHS.cdown d)                top     = CH.cdown
  chsᴰ→ch (CHS.cpair d)                top     = CH.cpair
  chsᴰ→ch (CHS.cfst d)                 top     = CH.cfst
  chsᴰ→ch (CHS.csnd d)                 top     = CH.csnd
  chsᴰ→ch (CHS.unit d)                 top     = CH.unit
  chsᴰ→ch (CHS.mp i j d)               (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.ci d)                   (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.ck d)                   (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.cs d)                   (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.nec `d d)               (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.cdist d)                (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.cup d)                  (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.cdown d)                (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.cpair d)                (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.cfst d)                 (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.csnd d)                 (pop k) = chsᴰ→ch d k
  chsᴰ→ch (CHS.unit d)                 (pop k) = chsᴰ→ch d k

  ᴬlem₂ : ∀ {Ξ A} → (d : CHS.⊢ᴰ Ξ) → (k : A ∈ Ξ)
         → chsᴿ→chᴿ CHS.ᴿ⌊ d ⌋ ⁱ⌊ k ⌋ ≡ CH.ᴿ⌊ chsᴰ→ch d k ⌋
  ᴬlem₂ CHS.nil                      ()
  ᴬlem₂ (CHS.mp i j d)               top     = cong² CH.APP (ᴬlem₂ d i) (ᴬlem₂ d j)
  ᴬlem₂ (CHS.ci d)                   top     = refl
  ᴬlem₂ (CHS.ck d)                   top     = refl
  ᴬlem₂ (CHS.cs d)                   top     = refl
  ᴬlem₂ (CHS.nec `d d)               top     rewrite ᴬlem₂ `d top = cong CH.BOX refl
  ᴬlem₂ (CHS.cdist {r₁ = r₁} {r₂} d) top     rewrite ᴬlem₁ r₁ r₂ = refl
  ᴬlem₂ (CHS.cup d)                  top     = refl
  ᴬlem₂ (CHS.cdown d)                top     = refl
  ᴬlem₂ (CHS.cpair d)                top     = refl
  ᴬlem₂ (CHS.cfst d)                 top     = refl
  ᴬlem₂ (CHS.csnd d)                 top     = refl
  ᴬlem₂ (CHS.unit d)                 top     = refl
  ᴬlem₂ (CHS.mp i j d)               (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.ci d)                   (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.ck d)                   (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.cs d)                   (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.nec `d d)               (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.cdist d)                (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.cup d)                  (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.cdown d)                (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.cpair d)                (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.cfst d)                 (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.csnd d)                 (pop k) = ᴬlem₂ d k
  ᴬlem₂ (CHS.unit d)                 (pop k) = ᴬlem₂ d k

chs→ch : ∀ {A} → CHS.⊢ A → CH.⊢ chsᵀ→chᵀ A
chs→ch (Ξ , d) = chsᴰ→ch d top

-- Translation from closed Hilbert-style to closed Hilbert-style sequential.

chᴿ→chsᴿ : CH.Rep → ∃ (λ n → CHS.Rep (suc n))
chᴿ→chsᴿ (CH.APP r₁ r₂) with chᴿ→chsᴿ r₁ | chᴿ→chsᴿ r₂
chᴿ→chsᴿ (CH.APP r₁ r₂) | (n₁ , r₁′) | (n₂ , r₂′) = suc n₂ + suc n₁ , CHS.APP r₁′ r₂′
chᴿ→chsᴿ CH.CI          = zero , CHS.CI CHS.NIL
chᴿ→chsᴿ CH.CK          = zero , CHS.CK CHS.NIL
chᴿ→chsᴿ CH.CS          = zero , CHS.CS CHS.NIL
chᴿ→chsᴿ (CH.BOX r)     with chᴿ→chsᴿ r
chᴿ→chsᴿ (CH.BOX r)     | (n , r′) = zero , CHS.BOX r′
chᴿ→chsᴿ CH.CDIST       = zero , CHS.CDIST CHS.NIL
chᴿ→chsᴿ CH.CUP         = zero , CHS.CUP CHS.NIL
chᴿ→chsᴿ CH.CDOWN       = zero , CHS.CDOWN CHS.NIL
chᴿ→chsᴿ CH.CPAIR       = zero , CHS.CPAIR CHS.NIL
chᴿ→chsᴿ CH.CFST        = zero , CHS.CFST CHS.NIL
chᴿ→chsᴿ CH.CSND        = zero , CHS.CSND CHS.NIL
chᴿ→chsᴿ CH.UNIT        = zero , CHS.UNIT CHS.NIL

chᴾ→chsᴾ : CH.Proof → CHS.Proof
chᴾ→chsᴾ CH.[ r ] with chᴿ→chsᴿ r
chᴾ→chsᴾ CH.[ r ] | (n , r′) = CHS.[ r′ ]

chᵀ→chsᵀ : CH.Ty → CHS.Ty
chᵀ→chsᵀ = chᴾ→chsᴾ ↦ᵀ_

distᴺ⌊⌋+ : ∀ {U} → (Γ Γ′ : Cx U) → ᴺ⌊ Γ ⧺ Γ′ ⌋ ≡ ᴺ⌊ Γ ⌋ + ᴺ⌊ Γ′ ⌋
distᴺ⌊⌋+ Γ ∅        = refl
distᴺ⌊⌋+ Γ (Γ′ , A) = cong suc (distᴺ⌊⌋+ Γ Γ′)

mutual
  ch→chs : ∀ {A} → CH.⊢ A → CHS.⊢ chᵀ→chsᵀ A
  ch→chs (CH.app d₁ d₂) = CHS.app (ch→chs d₁) (ch→chs d₂)
  ch→chs CH.ci          = ∅ , CHS.ci CHS.nil
  ch→chs CH.ck          = ∅ , CHS.ck CHS.nil
  ch→chs CH.cs          = ∅ , CHS.cs CHS.nil
  ch→chs (CH.box d)     rewrite ᴮlem₁ d = CHS.box (ch→chs d)
  ch→chs CH.cdist       = ∅ , CHS.cdist CHS.nil
  ch→chs CH.cup         = ∅ , CHS.cup CHS.nil
  ch→chs CH.cdown       = ∅ , CHS.cdown CHS.nil
  ch→chs CH.cpair       = ∅ , CHS.cpair CHS.nil
  ch→chs CH.cfst        = ∅ , CHS.cfst CHS.nil
  ch→chs CH.csnd        = ∅ , CHS.csnd CHS.nil
  ch→chs CH.unit        = ∅ , CHS.unit CHS.nil

  -- FIXME: This should hold by ᴮlem₂.
  postulate
    ᴮlem₁ : ∀ {A} → (d : CH.⊢ A)
           → chᴿ→chsᴿ CH.ᴿ⌊ d ⌋ ≡ ᴺ⌊ π₁ (ch→chs d) ⌋ , CHS.ᴿ⌊ π₂ (ch→chs d) ⌋

  ᴮlem₂ : ∀ {A} → (d : CH.⊢ A)
         → ᴺ⌊ π₁ (ch→chs d) ⌋ ≡ π₁ (chᴿ→chsᴿ CH.ᴿ⌊ d ⌋)
  ᴮlem₂ (CH.app d₁ d₂) rewrite ᴮlem₂ d₂ | ᴮlem₃ d₁ d₂ = cong suc refl
  ᴮlem₂ CH.ci          = refl
  ᴮlem₂ CH.ck          = refl
  ᴮlem₂ CH.cs          = refl
  ᴮlem₂ (CH.box d)     rewrite ᴮlem₂ d | ᴮlem₁ d = refl
  ᴮlem₂ CH.cdist       = refl
  ᴮlem₂ CH.cup         = refl
  ᴮlem₂ CH.cdown       = refl
  ᴮlem₂ CH.cpair       = refl
  ᴮlem₂ CH.cfst        = refl
  ᴮlem₂ CH.csnd        = refl
  ᴮlem₂ CH.unit        = refl

  ᴮlem₃ : ∀ {A B} → (d₁ : CH.⊢ A CH.▻ B) → (d₂ : CH.⊢ A)
         → ᴺ⌊ (π₁ (ch→chs d₂) , chᵀ→chsᵀ A) ⧺ π₁ (ch→chs d₁) ⌋ ≡
            suc (π₁ (chᴿ→chsᴿ CH.ᴿ⌊ d₂ ⌋)) + π₁ (chᴿ→chsᴿ CH.ᴿ⌊ d₁ ⌋)
  ᴮlem₃ {A} d₁ d₂ rewrite distᴺ⌊⌋+ (π₁ (ch→chs d₂) , chᵀ→chsᵀ A) (π₁ (ch→chs d₁)) =
                  cong² _+_ (cong suc (ᴮlem₂ d₂)) (ᴮlem₂ d₁)


module par-swap.properties where

open import par-swap
open import Esterel.Lang
open import Esterel.Lang.Binding
open import Esterel.Context
open import Data.List using ([] ; [_] ; _∷_ ; List ; _++_)
open import Data.Product

Context1-∥R : ∀{p p'} → (C1 : Context1) → p ∥R p' → ((C1 ∷ []) ⟦ p ⟧c) ∥R ((C1 ∷ []) ⟦ p' ⟧c)
Context1-∥R (ceval (epar₁ q₁)) (∥Rstep dc) = ∥Rstep (dcpar₁ dc)
Context1-∥R (ceval (epar₂ p₂)) (∥Rstep dc) = ∥Rstep (dcpar₂ dc)
Context1-∥R (ceval (eseq q₁)) (∥Rstep dc) = ∥Rstep (dcseq₁ dc)
Context1-∥R (ceval (eloopˢ q₁)) (∥Rstep dc) = ∥Rstep (dcloopˢ₁ dc)
Context1-∥R (ceval (esuspend S)) (∥Rstep dc) = ∥Rstep (dcsuspend dc)
Context1-∥R (ceval etrap) (∥Rstep dc) = ∥Rstep (dctrap dc)
Context1-∥R (csignl S) (∥Rstep dc) = ∥Rstep (dcsignl dc)
Context1-∥R (cpresent₁ S q₁) (∥Rstep dc) = ∥Rstep (dcpresent₁ dc)
Context1-∥R (cpresent₂ S p₂) (∥Rstep dc) = ∥Rstep (dcpresent₂ dc)
Context1-∥R cloop (∥Rstep dc) = ∥Rstep (dcloop dc)
Context1-∥R (cloopˢ₂ p₂) (∥Rstep dc) = ∥Rstep (dcloopˢ₂ dc)
Context1-∥R (cseq₂ p₂) (∥Rstep dc) = ∥Rstep (dcseq₂ dc)
Context1-∥R (cshared s e) (∥Rstep dc) = ∥Rstep (dcshared dc)
Context1-∥R (cvar x e) (∥Rstep dc) = ∥Rstep (dcvar dc)
Context1-∥R (cif₁ x q₁) (∥Rstep dc) = ∥Rstep (dcif₁ dc)
Context1-∥R (cif₂ x p₂) (∥Rstep dc) = ∥Rstep (dcif₂ dc)
Context1-∥R (cenv θ A) (∥Rstep dc) = ∥Rstep (dcenv dc)

Context1-∥R* : ∀ {p q} -> (C1 : Context1) -> p ∥R* q -> ((C1 ∷ []) ⟦ p ⟧c) ∥R* ((C1 ∷ []) ⟦ q ⟧c)
Context1-∥R* C1 ∥R0 = ∥R0
Context1-∥R* C1 (∥Rn p∥Rq q∥R*r) = ∥Rn (Context1-∥R C1 p∥Rq) (Context1-∥R* C1 q∥R*r)


module Channel where

open import Data.Bool hiding (_≤_)
open import Data.Fin hiding (_≤_)
open import Data.List hiding (map)
open import Data.Maybe
open import Data.Nat
open import Data.Nat.Properties
open import Data.Product hiding (map)
open import Relation.Binary.PropositionalEquality

open import Typing
open import Syntax hiding (send ; recv)
open import Global

data ChannelEnd : Set where
  POS NEG : ChannelEnd

otherEnd : ChannelEnd → ChannelEnd
otherEnd POS = NEG
otherEnd NEG = POS

-- the main part of a channel endpoint value is a valid channel reference
-- the channel end determines whether it's the front end or the back end of the channel
-- enforces that the session context has only one channel
data ChannelRef : (G : SCtx) (ce : ChannelEnd) (s : STypeF SType) → Set where
  here-pos : ∀ {s s'} {G : SCtx}
    → (ina-G : Inactive G)
    → s ≲' s'
    → ChannelRef (just (s , POS) ∷ G) POS s'
  here-neg : ∀ {s s'} {G : SCtx}
    → (ina-G : Inactive G)
    → dualF s ≲' s'
    → ChannelRef (just (s , NEG) ∷ G) NEG s'
  there : ∀ {b s} {G : SCtx}
    → (vcr : ChannelRef G b s)
    → ChannelRef (nothing ∷ G) b s

-- coerce channel ref to a supertype
vcr-coerce : ∀ {G b s s'} → ChannelRef G b s → s ≲' s' → ChannelRef G b s'
vcr-coerce (here-pos ina-G x) s≤s' = here-pos ina-G (subF-trans x s≤s')
vcr-coerce (here-neg ina-G x) s≤s' = here-neg ina-G (subF-trans x s≤s')
vcr-coerce (there vcr) s≤s' = there (vcr-coerce vcr s≤s')

-- find matching wait instruction in thread pool
vcr-match : ∀ {G G₁ G₂ b₁ b₂ s₁ s₂}
  → SSplit G G₁ G₂
  → ChannelRef G₁ b₁ s₁
  → ChannelRef G₂ b₂ s₂
  → Maybe (b₁ ≡ otherEnd b₂ × dualF s₂ ≲' s₁)
vcr-match () (here-pos _ _) (here-pos _ _)
vcr-match (ss-posneg ss) (here-pos{s} ina-G s<=s') (here-neg ina-G₁ ds<=s'') = just (refl , subF-trans (dual-subF ds<=s'') (subF-trans (eqF-implies-subF (eqF-sym (dual-involutionF s))) s<=s'))
vcr-match (ss-left ss) (here-pos _ _) (there vcr2) = nothing
vcr-match (ss-negpos ss) (here-neg ina-G ds<=s') (here-pos ina-G₁ s<=s'') = just (refl , subF-trans (dual-subF s<=s'') ds<=s')
vcr-match (ss-left ss) (here-neg _ _) (there vcr2) = nothing
vcr-match (ss-right ss) (there vcr1) (here-pos _ ina-G) = nothing
vcr-match (ss-right ss) (there vcr1) (here-neg _ ina-G) = nothing
vcr-match (ss-both ss) (there vcr1) (there vcr2) = vcr-match ss vcr1 vcr2

-- ok. brute force for a fixed tree with three levels
data SSplit2 (G G₁ G₂ G₁₁ G₁₂ : SCtx) : Set where
  ssplit2 :
    (ss1 : SSplit G G₁ G₂)
    → (ss2 : SSplit G₁ G₁₁ G₁₂)
    → SSplit2 G G₁ G₂ G₁₁ G₁₂

vcr-match-2-sr : ∀ {G G₁ G₂ G₁₁ G₁₂ b₁ b₂ s₁ s₂ t₁ t₂}
  → SSplit2 G G₁ G₂ G₁₁ G₁₂
  → ChannelRef G₁₁ b₁ (recv t₁ s₁)
  → ChannelRef G₁₂ b₂ (send t₂ s₂)
  → Maybe (SubT t₂ t₁ × dual s₂ ≲ s₁ ×
          ∃ λ G' → ∃ λ G₁' → ∃ λ G₁₁' → ∃ λ G₁₂' →
          SSplit2 G' G₁' G₂ G₁₁' G₁₂' ×
          ChannelRef G₁₁' b₁ (SType.force s₁) ×
          ChannelRef G₁₂' b₂ (SType.force s₂))
vcr-match-2-sr (ssplit2 ss-[] ()) (here-pos ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (here-pos ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-left ss1) ()) (here-pos ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (here-pos ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-posneg ss1) ()) (here-pos ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-negpos ss1) ()) (here-pos ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 ss-[] ()) (here-pos ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (here-pos ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-left ss1) (ss-posneg ss2)) (here-pos ina-G (sub-recv{s1} t t' t<=t' s1<=s1')) (here-neg ina-G₁ (sub-send .t t'' t'<=t s1<=s1'')) = just ((subt-trans t'<=t t<=t') , (sub-trans (dual-sub s1<=s1'') (sub-trans (eq-implies-sub (eq-sym (dual-involution s1))) s1<=s1')) , _ , _ , _ , _ , ssplit2 (ss-left ss1) (ss-posneg ss2) , here-pos ina-G (Sub.force s1<=s1') , here-neg ina-G₁ (Sub.force s1<=s1''))
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (here-pos ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-posneg ss1) ()) (here-pos ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-negpos ss1) ()) (here-pos ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 ss-[] ()) (here-pos ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (here-pos ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-left ss1) (ss-left ss2)) (here-pos ina-G x) (there vcr2) = nothing
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (here-pos ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-posneg ss1) (ss-left ss2)) (here-pos ina-G x) (there vcr2) = nothing
vcr-match-2-sr (ssplit2 (ss-negpos ss1) ()) (here-pos ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 ss-[] ()) (here-neg ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr {s₁ = s₁} {s₂} (ssplit2 (ss-left ss1) (ss-negpos ss2)) (here-neg ina-G (sub-recv .t t'' t<=t' s1<=s1'')) (here-pos ina-G₁ (sub-send t t' t'<=t s1<=s1')) = just ((subt-trans t'<=t t<=t') , ((sub-trans (dual-sub s1<=s1') s1<=s1'') , (_ , (_ , (_ , (_ , ((ssplit2 (ss-left ss1) (ss-negpos ss2)) , ((here-neg ina-G (Sub.force s1<=s1'')) , (here-pos ina-G₁ (Sub.force s1<=s1'))))))))))
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-posneg ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-negpos ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ x₁)
vcr-match-2-sr (ssplit2 ss-[] ()) (here-neg ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (here-neg ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (here-neg ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-posneg ss1) ()) (here-neg ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 (ss-negpos ss1) ()) (here-neg ina-G x) (here-neg ina-G₁ x₁)
vcr-match-2-sr (ssplit2 ss-[] ()) (here-neg ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (here-neg ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-left ss1) (ss-left ss2)) (here-neg ina-G x) (there vcr2) = nothing
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (here-neg ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-posneg ss1) ()) (here-neg ina-G x) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-negpos ss1) (ss-left ss2)) (here-neg ina-G x) (there vcr2) = nothing
vcr-match-2-sr (ssplit2 ss-[] ()) (there vcr1) (here-pos ina-G x)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (there vcr1) (here-pos ina-G x)
vcr-match-2-sr (ssplit2 (ss-left ss1) (ss-right ss2)) (there vcr1) (here-pos ina-G x) = nothing
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (there vcr1) (here-pos ina-G x)
vcr-match-2-sr (ssplit2 (ss-posneg ss1) (ss-right ss2)) (there vcr1) (here-pos ina-G x) = nothing
vcr-match-2-sr (ssplit2 (ss-negpos ss1) ()) (there vcr1) (here-pos ina-G x)
vcr-match-2-sr (ssplit2 ss-[] ()) (there vcr1) (here-neg ina-G x)
vcr-match-2-sr (ssplit2 (ss-both ss1) ()) (there vcr1) (here-neg ina-G x)
vcr-match-2-sr (ssplit2 (ss-left ss1) (ss-right ss2)) (there vcr1) (here-neg ina-G x) = nothing
vcr-match-2-sr (ssplit2 (ss-right ss1) ()) (there vcr1) (here-neg ina-G x)
vcr-match-2-sr (ssplit2 (ss-negpos ss1) (ss-right ss2)) (there vcr1) (here-neg ina-G x) = nothing
vcr-match-2-sr (ssplit2 ss-[] ()) (there vcr1) (there vcr2)
vcr-match-2-sr (ssplit2 (ss-both ss1) (ss-both ss2)) (there vcr1) (there vcr2) with vcr-match-2-sr (ssplit2 ss1 ss2) vcr1 vcr2
... | nothing = nothing
... | just (t2<=t1 , ds2<=s1 , _ , _ , _ , _ , ssplit2 ss1' ss2' , vcr1' , vcr2') = just (t2<=t1 , ds2<=s1 , _ , _ , _ , _ , (ssplit2 (ss-both ss1') (ss-both ss2')) , ((there vcr1') , (there vcr2')))
vcr-match-2-sr (ssplit2 (ss-right ss1) (ss-both ss2)) (there vcr1) (there vcr2) = map (λ { (t2<=t1 , ds2<=s1 , _ , _ , _ , _ , ssplit2 ss1' ss2' , vcr1' , vcr2') → t2<=t1 , ds2<=s1 , _ , _ , _ , _ , (ssplit2 (ss-right ss1') (ss-both ss2')) , (there vcr1') , (there vcr2') }) (vcr-match-2-sr (ssplit2 ss1 ss2) vcr1 vcr2)
vcr-match-2-sr (ssplit2 (ss-negpos ss1) ()) (there vcr1) (there vcr2)

vcr-match-2-sb : ∀ {G G₁ G₂ G₁₁ G₁₂ b₁ b₂ s₁₁ s₁₂ s₂₁ s₂₂}
  → SSplit2 G G₁ G₂ G₁₁ G₁₂
  → ChannelRef G₁₁ b₁ (sintern s₁₁ s₁₂)
  → ChannelRef G₁₂ b₂ (sextern s₂₁ s₂₂)
  → (lab : Selector)
  → Maybe (dual s₂₁ ≲ s₁₁ × dual s₂₂ ≲ s₁₂ ×
          ∃ λ G' → ∃ λ G₁' → ∃ λ G₁₁' → ∃ λ G₁₂' →
          SSplit2 G' G₁' G₂ G₁₁' G₁₂' ×
          ChannelRef G₁₁' b₁ (selection lab (SType.force s₁₁) (SType.force s₁₂)) ×
          ChannelRef G₁₂' b₂ (selection lab (SType.force s₂₁) (SType.force s₂₂)))
vcr-match-2-sb (ssplit2 ss1 ss2) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-pos ina-G₁ (sub-sextern s1<=s1'' s2<=s2'')) lab = nothing
vcr-match-2-sb (ssplit2 ss-[] ()) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-neg ina-G₁ x₁) lab
vcr-match-2-sb (ssplit2 (ss-both ss1) ()) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-neg ina-G₁ x₁) lab
vcr-match-2-sb (ssplit2 (ss-left ss1) (ss-posneg ss2)) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-neg ina-G₁ (sub-sextern s1<=s1'' s2<=s2'')) Left = just ((sub-trans (dual-sub s1<=s1'') (sub-trans (eq-implies-sub (eq-sym (dual-involution _))) s1<=s1')) , (sub-trans (dual-sub s2<=s2'') (sub-trans (eq-implies-sub (eq-sym (dual-involution _))) s2<=s2')) , _ , _ , _ , _ , (ssplit2 (ss-left ss1) (ss-posneg ss2)) , (here-pos ina-G (Sub.force s1<=s1')) , (here-neg ina-G₁ (Sub.force s1<=s1'')))
vcr-match-2-sb (ssplit2 (ss-left ss1) (ss-posneg ss2)) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-neg ina-G₁ (sub-sextern s1<=s1'' s2<=s2'')) Right = just ((sub-trans (dual-sub s1<=s1'') (sub-trans (eq-implies-sub (eq-sym (dual-involution _))) s1<=s1')) , (sub-trans (dual-sub s2<=s2'') (sub-trans (eq-implies-sub (eq-sym (dual-involution _))) s2<=s2')) , _ , _ , _ , _ , (ssplit2 (ss-left ss1) (ss-posneg ss2)) , (here-pos ina-G (Sub.force s2<=s2')) , (here-neg ina-G₁ (Sub.force s2<=s2'')))
vcr-match-2-sb (ssplit2 (ss-right ss1) ()) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-neg ina-G₁ x₁) lab
vcr-match-2-sb (ssplit2 (ss-posneg ss1) ()) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-neg ina-G₁ x₁) lab
vcr-match-2-sb (ssplit2 (ss-negpos ss1) ()) (here-pos ina-G (sub-sintern s1<=s1' s2<=s2')) (here-neg ina-G₁ x₁) lab
vcr-match-2-sb (ssplit2 ss1 ss2) (here-pos ina-G x) (there vcr2) lab = nothing
vcr-match-2-sb (ssplit2 ss-[] ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextern s1<=s1' s2<=s2')) lab
vcr-match-2-sb (ssplit2 (ss-both ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextern s1<=s1' s2<=s2')) lab
vcr-match-2-sb (ssplit2 (ss-left ss1) (ss-negpos ss2)) (here-neg ina-G (sub-sintern s1<=s1'' s2<=s2'')) (here-pos ina-G₁ (sub-sextern s1<=s1' s2<=s2')) Left = just ((sub-trans (dual-sub s1<=s1') s1<=s1'') , ((sub-trans (dual-sub s2<=s2') s2<=s2'') , (_ , (_ , (_ , (_ , ((ssplit2 (ss-left ss1) (ss-negpos ss2)) , ((here-neg ina-G (Sub.force s1<=s1'')) , (here-pos ina-G₁ (Sub.force s1<=s1'))))))))))
vcr-match-2-sb (ssplit2 (ss-left ss1) (ss-negpos ss2)) (here-neg ina-G (sub-sintern s1<=s1'' s2<=s2'')) (here-pos ina-G₁ (sub-sextern s1<=s1' s2<=s2')) Right = just ((sub-trans (dual-sub s1<=s1') s1<=s1'') , ((sub-trans (dual-sub s2<=s2') s2<=s2'') , (_ , (_ , (_ , (_ , ((ssplit2 (ss-left ss1) (ss-negpos ss2)) , ((here-neg ina-G (Sub.force s2<=s2'')) , (here-pos ina-G₁ (Sub.force s2<=s2'))))))))))
vcr-match-2-sb (ssplit2 (ss-right ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextern s1<=s1' s2<=s2')) lab
vcr-match-2-sb (ssplit2 (ss-posneg ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextern s1<=s1' s2<=s2')) lab
vcr-match-2-sb (ssplit2 (ss-negpos ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextern s1<=s1' s2<=s2')) lab
vcr-match-2-sb (ssplit2 ss1 ss2) (here-neg ina-G x) (here-neg ina-G₁ x₁) lab = nothing
vcr-match-2-sb (ssplit2 ss1 ss2) (here-neg ina-G x) (there vcr2) lab = nothing
vcr-match-2-sb (ssplit2 ss1 ss2) (there vcr1) (here-pos ina-G x) lab = nothing
vcr-match-2-sb (ssplit2 ss1 ss2) (there vcr1) (here-neg ina-G x) lab = nothing
vcr-match-2-sb (ssplit2 ss-[] ()) (there vcr1) (there vcr2) lab
vcr-match-2-sb (ssplit2 (ss-both ss1) (ss-both ss2)) (there vcr1) (there vcr2) lab = map (λ { (ds21<=s11 , ds22<=s12 , _ , _ , _ , _ , ssplit2 ss1' ss2' , vcr1' , vcr2') → ds21<=s11 , ds22<=s12 , _ , _ , _ , _ , (ssplit2 (ss-both ss1') (ss-both ss2')) , ((there vcr1') , (there vcr2')) }) (vcr-match-2-sb (ssplit2 ss1 ss2) vcr1 vcr2 lab)
vcr-match-2-sb (ssplit2 (ss-left ss1) ()) (there vcr1) (there vcr2) lab
vcr-match-2-sb (ssplit2 (ss-right ss1) (ss-both ss2)) (there vcr1) (there vcr2) lab = map  (λ { (ds21<=s11 , ds22<=s12 , _ , _ , _ , _ , ssplit2 ss1' ss2' , vcr1' , vcr2') → ds21<=s11 , ds22<=s12 , _ , _ , _ , _ , (ssplit2 (ss-right ss1') (ss-both ss2')) , ((there vcr1') , (there vcr2')) }) (vcr-match-2-sb (ssplit2 ss1 ss2) vcr1 vcr2 lab)
vcr-match-2-sb (ssplit2 (ss-posneg ss1) ()) (there vcr1) (there vcr2) lab
vcr-match-2-sb (ssplit2 (ss-negpos ss1) ()) (there vcr1) (there vcr2) lab

vcr-match-2-nsb : ∀ {G G₁ G₂ G₁₁ G₁₂ b₁ b₂ m₁ m₂ alti alte}
  → SSplit2 G G₁ G₂ G₁₁ G₁₂
  → ChannelRef G₁₁ b₁ (sintN m₁ alti)
  → ChannelRef G₁₂ b₂ (sextN m₂ alte)
  → (lab : Fin m₁)
  → Maybe (Σ (m₁ ≤ m₂) λ { p →
          ((i : Fin m₁) → dual (alti i) ≲ alte (inject≤ i p)) ×
          ∃ λ G' → ∃ λ G₁' → ∃ λ G₁₁' → ∃ λ G₁₂' →
          SSplit2 G' G₁' G₂ G₁₁' G₁₂' ×
          ChannelRef G₁₁' b₁ (SType.force (alti lab)) ×
          ChannelRef G₁₂' b₂ (SType.force (alte (inject≤ lab p)))})
vcr-match-2-nsb (ssplit2 ss1 ss2) (here-pos ina-G _) (here-pos ina-G₁ _) lab = nothing
vcr-match-2-nsb (ssplit2 ss-[] ()) (here-pos ina-G (sub-sintN m'≤m x)) (here-neg ina-G₁ x₁) lab
vcr-match-2-nsb (ssplit2 (ss-both ss1) ()) (here-pos ina-G (sub-sintN m'≤m x)) (here-neg ina-G₁ x₁) lab
vcr-match-2-nsb {m₁ = m₁} {alti = alti} {alte = alte} (ssplit2 (ss-left ss1) (ss-posneg ss2)) (here-pos ina-G (sub-sintN {alt = alt} m'≤m subint)) (here-neg ina-G₁ (sub-sextN m≤m' subext)) lab = just (≤-trans m'≤m m≤m' , auxSub , _ , _ , _ , _ , (ssplit2 (ss-left ss1) (ss-posneg ss2)) , (here-pos ina-G (Sub.force (subint lab))) , (here-neg ina-G₁ auxExt))
  where
    auxSub : (i : Fin m₁) → dual (alti i) ≲ alte (inject≤ i (≤-trans m'≤m m≤m'))
    auxSub i with subext (inject≤ i m'≤m)
    ... | r  rewrite (inject-trans m≤m' m'≤m i) = sub-trans (dual-sub (subint i)) r
    auxExt : dualF (SType.force (alt (inject≤ lab m'≤m))) ≲' SType.force (alte (inject≤ lab (≤-trans m'≤m m≤m')))
    auxExt with Sub.force (subext (inject≤ lab m'≤m))
    ... | se rewrite inject-trans  m≤m' m'≤m lab = se
vcr-match-2-nsb (ssplit2 (ss-right ss1) ()) (here-pos ina-G (sub-sintN m'≤m x)) (here-neg ina-G₁ x₁) lab
vcr-match-2-nsb (ssplit2 (ss-posneg ss1) ()) (here-pos ina-G (sub-sintN m'≤m x)) (here-neg ina-G₁ x₁) lab
vcr-match-2-nsb (ssplit2 (ss-negpos ss1) ()) (here-pos ina-G (sub-sintN m'≤m x)) (here-neg ina-G₁ x₁) lab
vcr-match-2-nsb (ssplit2 ss1 ss2) (here-pos ina-G x) (there vcr2) lab = nothing
vcr-match-2-nsb (ssplit2 ss-[] ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextN m≤m' x₁)) lab
vcr-match-2-nsb (ssplit2 (ss-both ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextN m≤m' x₁)) lab
vcr-match-2-nsb {m₁ = m₁} {alti = alti} {alte = alte} (ssplit2 (ss-left ss1) (ss-negpos ss2)) (here-neg ina-G (sub-sintN m'≤m subint)) (here-pos ina-G₁ (sub-sextN {alt = alt} m≤m' subext)) lab = just ((≤-trans m'≤m m≤m') , auxSub , _ , _ , _ , _ , ssplit2 (ss-left ss1) (ss-negpos ss2) , here-neg ina-G (Sub.force (subint lab)) , here-pos ina-G₁ auxExt)
  where
    auxSub : (i : Fin m₁) → dual (alti i) ≲ alte (inject≤ i (≤-trans m'≤m m≤m'))
    auxSub i with subext (inject≤ i m'≤m)
    ... | sub2 rewrite (inject-trans m≤m' m'≤m i) =
      sub-trans (sub-trans (dual-sub (subint i)) (eq-implies-sub (eq-sym (dual-involution _)))) sub2
    auxExt : SType.force (alt (inject≤ lab m'≤m)) ≲' SType.force (alte (inject≤ lab (≤-trans m'≤m m≤m')))
    auxExt with Sub.force (subext (inject≤ lab m'≤m))
    ... | se rewrite (inject-trans m≤m' m'≤m lab) = se
vcr-match-2-nsb (ssplit2 (ss-right ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextN m≤m' x₁)) lab
vcr-match-2-nsb (ssplit2 (ss-posneg ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextN m≤m' x₁)) lab
vcr-match-2-nsb (ssplit2 (ss-negpos ss1) ()) (here-neg ina-G x) (here-pos ina-G₁ (sub-sextN m≤m' x₁)) lab
vcr-match-2-nsb (ssplit2 ss1 ss2) (here-neg ina-G x) (here-neg ina-G₁ x₁) lab = nothing
vcr-match-2-nsb (ssplit2 ss1 ss2) (here-neg ina-G x) (there vcr2) lab = nothing
vcr-match-2-nsb (ssplit2 ss1 ss2) (there vcr1) (here-pos ina-G x) lab = nothing
vcr-match-2-nsb (ssplit2 ss1 ss2) (there vcr1) (here-neg ina-G x) lab = nothing
vcr-match-2-nsb (ssplit2 ss-[] ()) (there vcr1) (there vcr2) lab
vcr-match-2-nsb (ssplit2 (ss-both ss1) (ss-both ss2)) (there vcr1) (there vcr2) lab =
  map (λ { (m1≤m2 , fdi≤e , _ , _ , _ , _ , ssplit2 ss1' ss2' , vcr1' , vcr2') → m1≤m2 , fdi≤e , _ , _ , _ , _ , (ssplit2 (ss-both ss1') (ss-both ss2')) , there vcr1' , there vcr2' })
      (vcr-match-2-nsb (ssplit2 ss1 ss2) vcr1 vcr2 lab)
vcr-match-2-nsb (ssplit2 (ss-left ss1) ()) (there vcr1) (there vcr2) lab
vcr-match-2-nsb (ssplit2 (ss-right ss1) (ss-both ss2)) (there vcr1) (there vcr2) lab =
  map (λ { (m1≤m2 , fdi≤e , _ , _ , _ , _ , ssplit2 ss1' ss2' , vcr1' , vcr2') → m1≤m2 , fdi≤e , _ , _ , _ , _ , (ssplit2 (ss-right ss1') (ss-both ss2')) , there vcr1' , there vcr2' })
      (vcr-match-2-nsb (ssplit2 ss1 ss2) vcr1 vcr2 lab)
vcr-match-2-nsb (ssplit2 (ss-posneg ss1) ()) (there vcr1) (there vcr2) lab
vcr-match-2-nsb (ssplit2 (ss-negpos ss1) ()) (there vcr1) (there vcr2) lab


{-# OPTIONS --safe #-}

open import Definition.Typed.EqualityRelation

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

open import Definition.Untyped
open import Definition.Untyped.Properties
open import Definition.Typed
open import Definition.Typed.Properties
import Definition.Typed.Weakening as Twk
open import Definition.Typed.EqualityRelation
open import Definition.Typed.RedSteps
open import Definition.LogicalRelation
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Application
open import Definition.LogicalRelation.Substitution
import Definition.LogicalRelation.Weakening as Lwk
open import Definition.LogicalRelation.Substitution.Properties
import Definition.LogicalRelation.Substitution.Irrelevance as S
open import Definition.LogicalRelation.Substitution.Reflexivity
open import Definition.LogicalRelation.Substitution.Weakening
-- open import Definition.LogicalRelation.Substitution.Introductions.Nat
open import Definition.LogicalRelation.Substitution.Introductions.Empty
-- open import Definition.LogicalRelation.Substitution.Introductions.Pi
-- open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst
open import Definition.LogicalRelation.Substitution.Introductions.Universe
open import Definition.LogicalRelation.Substitution.MaybeEmbed

open import Tools.Product
open import Tools.Empty
import Tools.Unit as TU
import Tools.PropositionalEquality as PE
import Data.Nat as Nat

module cast-ΠΠ-lemmas
       {Γ rF F F₁}
       (⊢Γ : ⊢ Γ)
       (⊢F : Γ ⊢ F ^ [ rF , ι ⁰ ])
       ([F] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F ^ [ rF , ι ⁰ ])
       (⊢F₁    : Γ ⊢ F₁ ^ [ rF , ι ⁰ ])
       ([F₁] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₁ ^ [ rF , ι ⁰ ])
       (recursor : ∀ {x e ρ Δ}
         ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
         ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         (⊢e : Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F) ^ [ % , ι ¹ ])
         → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₁) (wk ρ F) e x ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
       (extrecursor : ∀ {ρ Δ x y e e′}
         → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
         → ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([x≡y] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → (⊢e : Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F) ^ [ % , ι ¹ ])
         → (⊢e′ : Δ ⊢ e′ ∷ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F) ^ [ % , ι ¹ ])
         → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₁) (wk ρ F) e x ≡ cast ⁰ (wk ρ F₁) (wk ρ F) e′ y ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
  where
    b = λ ρ e x → cast ⁰ (wk ρ F₁) (wk ρ F) (Idsym (Univ rF ⁰) (wk ρ F) (wk ρ F₁) e) x

    [b] : ∀ {ρ Δ e x} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
        → (Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F) (wk ρ F₁) ^ [ % , ι ¹ ])
        → (Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → Δ ⊩⟨ ι ⁰ ⟩ b ρ e x ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ
    [b] [ρ] ⊢Δ ⊢e [x] =
      let
        ⊢e′ = Idsymⱼ (univ 0<1 ⊢Δ) (un-univ (escape ([F] [ρ] ⊢Δ)))
                     (un-univ (escape ([F₁] [ρ] ⊢Δ))) ⊢e
      in recursor [ρ] ⊢Δ [x] ⊢e′

    [bext] : ∀ {ρ Δ e e′ x y} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
        → (Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F) (wk ρ F₁) ^ [ % , ι ¹ ])
        → (Δ ⊢ e′ ∷ Id (Univ rF ⁰) (wk ρ F) (wk ρ F₁) ^ [ % , ι ¹ ])
        → (Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → (Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → (Δ ⊩⟨ ι ⁰ ⟩ x ≡ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → Δ ⊩⟨ ι ⁰ ⟩ b ρ e x ≡ b ρ e′ y ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ
    [bext] [ρ] ⊢Δ ⊢e ⊢e′ [x] [y] [x≡y] =
      let
        ⊢syme = Idsymⱼ (univ 0<1 ⊢Δ) (un-univ (escape ([F] [ρ] ⊢Δ)))
          (un-univ (escape ([F₁] [ρ] ⊢Δ))) ⊢e
        ⊢syme′ = Idsymⱼ (univ 0<1 ⊢Δ) (un-univ (escape ([F] [ρ] ⊢Δ)))
          (un-univ (escape ([F₁] [ρ] ⊢Δ))) ⊢e′
      in extrecursor [ρ] ⊢Δ [x] [y] [x≡y] ⊢syme ⊢syme′

module cast-ΠΠ-lemmas-2
       {t e f Γ A B F rF G F₁ G₁}
       (⊢Γ : ⊢ Γ)
       (⊢A : Γ ⊢ A ^ [ ! , ι ⁰ ])
       (⊢ΠFG : Γ ⊢ Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D : Γ ⊢ A ⇒* Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F : Γ ⊢ F ^ [ rF , ι ⁰ ])
       (⊢G : (Γ ∙ F ^ [ rF , ι ⁰ ]) ⊢ G ^ [ ! , ι ⁰ ])
       (A≡A : Γ ⊢ (Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰) ≅ (Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F ^ [ rF , ι ⁰ ])
       ([G] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G [ a ] ^ [ ! , ι ⁰ ]))
       (G-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G [ a ] ≡ wk (lift ρ) G [ b ] ^ [ ! , ι ⁰ ] / ([G] [ρ] ⊢Δ [a])))
       (⊢B     : Γ ⊢ B ^ [ ! , ι ⁰ ])
       (⊢ΠF₁G₁ : Γ ⊢ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₁     : Γ ⊢ B ⇒* Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₁    : Γ ⊢ F₁ ^ [ rF , ι ⁰ ])
       (⊢G₁    : (Γ ∙ F₁ ^ [ rF , ι ⁰ ]) ⊢ G₁ ^ [ ! , ι ⁰ ])
       (A₁≡A₁  : Γ ⊢ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ≅ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₁] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₁ ^ [ rF , ι ⁰ ])
       ([G₁] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ^ [ ! , ι ⁰ ]))
       (G₁-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ≡ wk (lift ρ) G₁ [ b ] ^ [ ! , ι ⁰ ] / ([G₁] [ρ] ⊢Δ [a])))
       (⊢e : Γ ⊢ e ∷ Id (U ⁰) A B ^ [ % , ι ¹ ])
       (recursor : ∀ {ρ Δ x y t e}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([t] : Δ ⊩⟨ ι ⁰ ⟩ t ∷ wk (lift ρ) G [ x ] ^ [ ! , ι ⁰ ] / [G] [ρ] ⊢Δ [x])
          (⊢e : Δ ⊢ e ∷ Id (U ⁰) (wk (lift ρ) G [ x ]) (wk (lift ρ) G₁ [ y ]) ^ [ % , ι ¹ ])
          → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk (lift ρ) G [ x ]) (wk (lift ρ) G₁ [ y ]) e t ∷ wk (lift ρ) G₁ [ y ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [y])
       (extrecursor : ∀ {ρ Δ x x′ y y′ t t′ e e′}
         → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
         → ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
         → ([x′] : Δ ⊩⟨ ι ⁰ ⟩ x′ ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
         → ([x≡x′] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ x′ ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
         → ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([y′] : Δ ⊩⟨ ι ⁰ ⟩ y′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([y≡y′] : Δ ⊩⟨ ι ⁰ ⟩ y ≡ y′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([t] : Δ ⊩⟨ ι ⁰ ⟩ t ∷ wk (lift ρ) G [ x ] ^ [ ! , ι ⁰ ] / [G] [ρ] ⊢Δ [x])
         → ([t′] : Δ ⊩⟨ ι ⁰ ⟩ t′ ∷ wk (lift ρ) G [ x′ ] ^ [ ! , ι ⁰ ] / [G] [ρ] ⊢Δ [x′])
         → ([t≡t′] : Δ ⊩⟨ ι ⁰ ⟩ t ≡ t′ ∷ wk (lift ρ) G [ x ] ^ [ ! , ι ⁰ ] / [G] [ρ] ⊢Δ [x])
         → (⊢e : Δ ⊢ e ∷ Id (U ⁰) (wk (lift ρ) G [ x ]) (wk (lift ρ) G₁ [ y ]) ^ [ % , ι ¹ ])
         → (⊢e′ : Δ ⊢ e′ ∷ Id (U ⁰) (wk (lift ρ) G [ x′ ]) (wk (lift ρ) G₁ [ y′ ]) ^ [ % , ι ¹ ])
         → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk (lift ρ) G [ x ]) (wk (lift ρ) G₁ [ y ]) e t ≡ cast ⁰ (wk (lift ρ) G [ x′ ]) (wk (lift ρ) G₁ [ y′ ]) e′ t′ ∷ wk (lift ρ) G₁ [ y ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [y])
       (⊢t : Γ ⊢ t ∷ Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (Df : Γ ⊢ t ⇒* f ∷ Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰ ^ ι ⁰)
       ([fext] : ∀ {ρ Δ a b} →
                ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
                ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
                ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
              → Δ ⊩⟨ ι ⁰ ⟩ wk ρ f ∘ a ^ ⁰ ≡ wk ρ f ∘ b ^ ⁰ ∷ wk (lift ρ) G [ a ] ^ [ ! , ι ⁰ ] / [G] [ρ] ⊢Δ [a])
       ([f] : ∀ {ρ Δ a}
              → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
              → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
              → Δ ⊩⟨ ι ⁰ ⟩ wk ρ f ∘ a ^ ⁰ ∷ wk (lift ρ) G [ a ] ^ [ ! , ι ⁰ ] / [G] [ρ] ⊢Δ [a])
       ([b] : ∀ {ρ Δ e x}
                ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                (⊢e : Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F) (wk ρ F₁) ^ [ % , ι ¹ ])
                ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
                → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₁) (wk ρ F) (Idsym (Univ rF ⁰) (wk ρ F) (wk ρ F₁) e) x ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
       ([bext] : ∀ {ρ Δ e e′ x y} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
           → (Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F) (wk ρ F₁) ^ [ % , ι ¹ ])
           → (Δ ⊢ e′ ∷ Id (Univ rF ⁰) (wk ρ F) (wk ρ F₁) ^ [ % , ι ¹ ])
           → (Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
           → (Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
           → (Δ ⊩⟨ ι ⁰ ⟩ x ≡ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
           → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₁) (wk ρ F) (Idsym (Univ rF ⁰) (wk ρ F) (wk ρ F₁) e) x
             ≡ cast ⁰ (wk ρ F₁) (wk ρ F) (Idsym (Univ rF ⁰) (wk ρ F) (wk ρ F₁) e′) y ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
  where
    b = λ ρ e x → cast ⁰ (wk ρ F₁) (wk ρ F) (Idsym (Univ rF ⁰) (wk ρ F) (wk ρ F₁) e) x

    ⊢IdFF₁ : Γ ⊢ Id (Univ rF ⁰) F F₁ ^ [ % , ι ¹ ]
    ⊢IdFF₁ = univ (Idⱼ (univ 0<1 ⊢Γ) (un-univ ⊢F) (un-univ ⊢F₁))

    Δ₀ = Γ ∙ Id (Univ rF ⁰) F F₁ ^ [ % , ι ¹ ] ∙ wk1 F₁ ^ [ rF , ι ⁰ ]
    ρ₀ = (step (step id))

    ⊢IdG₁G : Γ ∙ Id (Univ rF ⁰) F F₁ ^ [ % , ι ¹ ] ⊢ Π (wk1 F₁) ^ rF ° ⁰ ▹ Id (U ⁰) ((wk1d G) [ b ρ₀ (var 1) (var 0) ]↑) (wk1d G₁) ° ¹ ° ¹ ^ [ % , ι ¹ ]
    ⊢IdG₁G =
      let
        ⊢Δ₀ : ⊢ Δ₀
        ⊢Δ₀ = ⊢Γ ∙ ⊢IdFF₁ ∙ univ (Twk.wkTerm (Twk.step Twk.id) (⊢Γ ∙ ⊢IdFF₁) (un-univ ⊢F₁))
        [ρ₀] : ρ₀ Twk.∷ Δ₀ ⊆ Γ
        [ρ₀] = Twk.step (Twk.step Twk.id)
        [0] : Δ₀ ⊩⟨ ι ⁰ ⟩ var 0 ∷ wk ρ₀ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ₀] ⊢Δ₀
        [0] = let x = (var ⊢Δ₀ (PE.subst (λ X → 0 ∷ X ^ [ rF , ι ⁰ ] ∈ Δ₀) (wk1-wk (step id) F₁) here)) in
          neuTerm ([F₁] [ρ₀] ⊢Δ₀) (var 0) x (~-var x)
        ⊢1 : Δ₀ ⊢ (var 1) ∷ Id (Univ rF ⁰) (wk ρ₀ F) (wk ρ₀ F₁) ^ [ % , ι ¹ ]
        ⊢1 = var ⊢Δ₀ (PE.subst₂ (λ X Y → 1 ∷ Id (Univ rF ⁰) X Y ^ [ % , ι ¹ ] ∈ Δ₀)
          (wk1-wk (step id) F) (wk1-wk (step id) F₁) (there here))
        ⊢G₀ : Δ₀ ⊢ wk (lift ρ₀) G [ b ρ₀ (var 1) (var 0) ] ^ [ ! , ι ⁰ ]
        ⊢G₀ = escape ([G] [ρ₀] ⊢Δ₀ ([b] [ρ₀] ⊢Δ₀ ⊢1 [0]))
        ⊢G₀′ = PE.subst (λ X → Δ₀ ⊢ X ^ [ ! , ι ⁰ ]) (PE.sym (cast-subst-lemma2 G (b ρ₀ (var 1) (var 0)))) ⊢G₀
        x₀ : Δ₀ ⊢ Id (U ⁰) ((wk1d G) [ b ρ₀ (var 1) (var 0) ]↑) (wk1d G₁) ∷ SProp ¹ ^ [ ! , ∞ ]
        x₀ = Idⱼ (univ 0<1 ⊢Δ₀) (un-univ ⊢G₀′)
            (un-univ (Twk.wk (Twk.lift (Twk.step Twk.id)) ⊢Δ₀ ⊢G₁))
        x₁ = Πⱼ <is≤ 0<1 ▹ ≡is≤ PE.refl ▹ Twk.wkTerm (Twk.step Twk.id) (⊢Γ ∙ ⊢IdFF₁) (un-univ ⊢F₁) ▹ x₀
      in univ x₁

    ⊢e′ : Γ ⊢ e ∷ ∃ (Id (Univ rF ⁰) F F₁) ▹ (Π (wk1 F₁) ^ rF ° ⁰ ▹ Id (U ⁰) ((wk1d G) [ b ρ₀ (var 1) (var 0) ]↑) (wk1d G₁) ° ¹ ° ¹) ^ [ % , ι ¹ ]
    ⊢e′ =
      let
        b₀ = cast ⁰ (wk1 (wk1 F₁)) (wk1 (wk1 F)) (Idsym (Univ rF ⁰) (wk1 (wk1 F)) (wk1 (wk1 F₁)) (var 1)) (var 0)
        b≡b₀ : b ρ₀ (var 1) (var 0) PE.≡ b₀
        b≡b₀ = PE.cong₂ (λ X Y → cast ⁰ Y X (Idsym (Univ rF ⁰) X Y (var 1)) (var 0))
          (PE.sym (wk1-wk (step id) F)) (PE.sym (wk1-wk (step id) F₁))
        x₀ = conv ⊢e (univ (Id-cong (refl (univ 0<1 ⊢Γ)) (un-univ≡ (subset* D)) (un-univ≡ (subset* D₁))))
        x₁ = conv x₀ (univ (Id-U-ΠΠ (un-univ ⊢F) (un-univ ⊢G) (un-univ ⊢F₁) (un-univ ⊢G₁)))
        x₂ = PE.subst (λ X → Γ ⊢ e ∷ ∃ (Id (Univ rF ⁰) F F₁) ▹ (Π (wk1 F₁) ^ rF ° ⁰ ▹ Id (U ⁰) ((wk1d G) [ X ]↑) (wk1d G₁) ° ¹ ° ¹) ^ [ % , ι ¹ ]) (PE.sym b≡b₀) x₁
      in x₂

    ⊢fste : Γ ⊢ fst e ∷ Id (Univ rF ⁰) F F₁ ^ [ % , ι ¹ ]
    ⊢fste = fstⱼ (un-univ ⊢IdFF₁) (un-univ ⊢IdG₁G) ⊢e′

    ⊢snde : Γ ⊢ snd e ∷ Π F₁ ^ rF ° ⁰ ▹ Id (U ⁰) (wk1d G [ b (step id) (fst (wk1 e)) (var 0) ]) G₁ ° ¹ ° ¹ ^ [ % , ι ¹ ]
    ⊢snde =
      let
        x₀ = sndⱼ (un-univ ⊢IdFF₁) (un-univ ⊢IdG₁G) ⊢e′
        x₁ = PE.subst₂ (λ X Y → Γ ⊢ snd e ∷ (Π X ^ rF ° ⁰ ▹ subst _ (Id (U ⁰) Y (wk1d G₁)) ° ¹ ° ¹) ^ [ % , ι ¹ ])
            (wk1-singleSubst F₁ (fst e)) (cast-subst-lemma2 G (b ρ₀ (var 1) (var 0))) x₀
        x₂ = PE.subst₂ (λ X Y → Γ ⊢ snd e ∷ Π F₁ ^ rF ° ⁰ ▹ Id (U ⁰) X Y ° ¹ ° ¹ ^ [ % , ι ¹ ])
          (singleSubstLift (wk (lift ρ₀) G) (b ρ₀ (var 1) (var 0))) (wk1d-singleSubst G₁ (fst e)) x₁
        σ = liftSubst (sgSubst (fst e))
        b≡b : subst σ (b ρ₀ (var 1) (var 0)) PE.≡ b (step id) (fst (wk1 e)) (var 0)
        b≡b = PE.trans (PE.cong (λ X → cast ⁰ (subst σ (wk ρ₀ F₁)) (subst σ (wk ρ₀ F)) X (var 0)) (subst-Idsym σ (Univ rF ⁰) (wk ρ₀ F) (wk ρ₀ F₁) (var 1)))
          (PE.cong₂ (λ X Y → cast ⁰ Y X (Idsym (Univ rF ⁰) X Y (fst (wk1 e))) (var 0)) (cast-subst-lemma5 F (fst e)) (cast-subst-lemma5 F₁ (fst e)))
        x₃ = PE.subst₂ (λ X Y → Γ ⊢ snd e ∷ Π F₁ ^ rF ° ⁰ ▹ Id (U ⁰) (X [ Y ]) G₁ ° ¹ ° ¹ ^ [ % , ι ¹ ])
          (cast-subst-lemma3 G (fst e)) b≡b x₂
     in x₃

    ⊢snde′ : ∀ {ρ Δ x} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
        → (⊢x : Δ ⊢ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ])
        → Δ ⊢ snd (wk ρ e) ∘ x ^ ¹ ∷ Id (U ⁰) (wk (lift ρ) G [ b ρ (fst (wk ρ e)) x ])
          (wk (lift ρ) G₁ [ x ]) ^ [ % , ι ¹ ]
    ⊢snde′ {ρ} {Δ} {x} [ρ] ⊢Δ ⊢x =
      let
        -- I should probably make some generic lemma about pushing weakening and subst in b
        y₀ = PE.trans (PE.cong (λ X → X [ x ]) (wk-Idsym (lift ρ) (Univ rF ⁰) (wk1 F) (wk1 F₁) (fst (wk1 e))))
          (PE.trans (subst-Idsym (sgSubst x) (Univ rF ⁰) (wk (lift ρ) (wk1 F)) (wk (lift ρ) (wk1 F₁)) (fst (wk (lift ρ) (wk1 e))))
          (PE.cong₃ (λ X Y Z → Idsym (Univ rF ⁰) X Y (fst Z)) (irrelevant-subst′ ρ F x) (irrelevant-subst′ ρ F₁ x) (irrelevant-subst′ ρ e x)))
        y₁ : wk (lift ρ) (b (step id) (fst (wk1 e)) (var 0)) [ x ] PE.≡ b ρ (fst (wk ρ e)) x
        y₁ = PE.cong₃ (λ X Y Z → cast ⁰ X Y Z x) (irrelevant-subst′ ρ F₁ x) (irrelevant-subst′ ρ F x) y₀
        x₀ : Δ ⊢ (wk ρ (snd e)) ∘ x ^ ¹ ∷ Id (U ⁰) (wk (lift ρ) (wk1d G [ b (step id) (fst (wk1 e)) (var 0) ]) [ x ]) (wk (lift ρ) G₁ [ x ]) ^ [ % , ι ¹ ]
        x₀ = Twk.wkTerm [ρ] ⊢Δ ⊢snde ∘ⱼ ⊢x
        x₁ = PE.cong₂ (λ X Y → X [ Y ]) (cast-subst-lemma4 ρ x G) y₁
        x₂ = PE.trans (singleSubstLift (wk (lift (lift ρ)) (wk1d G))
          (wk (lift ρ) (b (step id) (fst (wk1 e)) (var 0)))) x₁
        x₃ = PE.trans (PE.cong (λ X → X [ x ]) (wk-β {a = b (step id) (fst (wk1 e)) (var 0)} (wk1d G))) x₂
        x₄ = PE.subst (λ X → Δ ⊢ snd (wk ρ e) ∘ x ^ ¹ ∷ Id (U ⁰) X (wk (lift ρ) G₁ [ x ]) ^ [ % , ι ¹ ]) x₃ x₀
      in x₄

    g = λ ρ x → cast ⁰ (wk (lift ρ) G [ b ρ (fst (wk ρ e)) x ]) (wk (lift ρ) G₁ [ x ])
      ((snd (wk ρ e)) ∘ x ^ ¹) ((wk ρ t) ∘ (b ρ (fst (wk ρ e)) x) ^ ⁰)

    [g] : ∀ {ρ Δ x} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
        → ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → Δ ⊩⟨ ι ⁰ ⟩ g ρ x ∷ wk (lift ρ) G₁ [ x ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x]
    [g] {ρ} {Δ} {x} [ρ] ⊢Δ [x] =
      let
        [b]′ = [b] [ρ] ⊢Δ (Twk.wkTerm [ρ] ⊢Δ ⊢fste) [x]
        [t] = proj₁ (redSubst*Term (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [b]′) (Twk.wkRed*Term [ρ] ⊢Δ Df))
          ([G] [ρ] ⊢Δ [b]′) ([f] [ρ] ⊢Δ [b]′))
      in recursor [ρ] ⊢Δ [b]′ [x] [t] (⊢snde′ [ρ] ⊢Δ (escapeTerm ([F₁] [ρ] ⊢Δ) [x]))

    [gext] : ∀ {ρ Δ x y} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
        → ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → ([x≡y] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
        → Δ ⊩⟨ ι ⁰ ⟩ g ρ x ≡ g ρ y ∷ wk (lift ρ) G₁ [ x ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x]
    [gext] {ρ} {Δ} {x} {y} [ρ] ⊢Δ [x] [y] [x≡y] =
      let
        [b₁] = [b] [ρ] ⊢Δ (Twk.wkTerm [ρ] ⊢Δ ⊢fste) [x]
        [b₂] = [b] [ρ] ⊢Δ (Twk.wkTerm [ρ] ⊢Δ ⊢fste) [y]
        [b₁≡b₂] = [bext] [ρ] ⊢Δ (Twk.wkTerm [ρ] ⊢Δ ⊢fste) (Twk.wkTerm [ρ] ⊢Δ ⊢fste) [x] [y] [x≡y]
        D₁ = (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [b₁]) (Twk.wkRed*Term [ρ] ⊢Δ Df))
        D₂ = (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [b₂]) (Twk.wkRed*Term [ρ] ⊢Δ Df))
        [t₁] = proj₁ (redSubst*Term D₁ ([G] [ρ] ⊢Δ [b₁]) ([f] [ρ] ⊢Δ [b₁]))
        [t₂] = proj₁ (redSubst*Term D₂ ([G] [ρ] ⊢Δ [b₂]) ([f] [ρ] ⊢Δ [b₂]))
        [t₁≡t₂] = redSubst*EqTerm D₁ D₂ ([G] [ρ] ⊢Δ [b₁]) ([G] [ρ] ⊢Δ [b₂]) (G-ext [ρ] ⊢Δ [b₁] [b₂] [b₁≡b₂])
          ([f] [ρ] ⊢Δ [b₁]) ([f] [ρ] ⊢Δ [b₂]) ([fext] [ρ] ⊢Δ [b₁] [b₂] [b₁≡b₂])
      in extrecursor [ρ] ⊢Δ [b₁] [b₂] [b₁≡b₂] [x] [y] [x≡y] [t₁] [t₂] [t₁≡t₂] (⊢snde′ [ρ] ⊢Δ (escapeTerm ([F₁] [ρ] ⊢Δ) [x])) (⊢snde′ [ρ] ⊢Δ (escapeTerm ([F₁] [ρ] ⊢Δ) [y]))

    Δ₁ = Γ ∙ F₁ ^ [ rF , ι ⁰ ]
    ⊢Δ₁ : ⊢ Δ₁
    ⊢Δ₁ = ⊢Γ ∙ ⊢F₁
    ρ₁ = (step id)
    [ρ₁] : ρ₁ Twk.∷ Δ₁ ⊆ Γ
    [ρ₁] = Twk.step Twk.id
    [0] : Δ₁ ⊩⟨ ι ⁰ ⟩ var 0 ∷ wk ρ₁ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ₁] ⊢Δ₁
    [0] = neuTerm ([F₁] [ρ₁] ⊢Δ₁) (var 0) (var ⊢Δ₁ here) (~-var (var ⊢Δ₁ here))

    ⊢g0 = PE.subst (λ X → Δ₁ ⊢ g (step id) (var 0) ∷ X ^ [ ! , ι ⁰ ]) (wkSingleSubstId G₁) (escapeTerm ([G₁] [ρ₁] ⊢Δ₁ [0]) ([g] [ρ₁] ⊢Δ₁ [0]))
    ⊢λg : Γ ⊢ lam F₁ ▹ g (step id) (var 0) ^ ⁰ ∷ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ]
    ⊢λg = lamⱼ (≡is≤ PE.refl) (≡is≤ PE.refl) ⊢F₁ ⊢g0

    Dg : Γ ⊢ cast ⁰ A B e t :⇒*: (lam F₁ ▹ g (step id) (var 0) ^ ⁰) ∷ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ ι ⁰
    Dg =
      let
        g0 = lam F₁ ▹ cast ⁰ (G [ b (step id) (fst (wk1 e)) (var 0) ]↑) G₁
          ((snd (wk1 e)) ∘ (var 0) ^ ¹) ((wk1 t) ∘ (b (step id) (fst (wk1 e)) (var 0)) ^ ⁰) ^ ⁰
        g≡g : g0 PE.≡ lam F₁ ▹ g (step id) (var 0) ^ ⁰
        g≡g = PE.cong₂ (λ X Y → lam F₁ ▹ cast ⁰ X Y ((snd (wk1 e)) ∘ (var 0) ^ ¹) ((wk1 t) ∘ (b (step id) (fst (wk1 e)) (var 0)) ^ ⁰) ^ ⁰)
          (wk1d[]-[]↑ G (b (step id) (fst (wk1 e)) (var 0))) (PE.sym (wkSingleSubstId G₁))
        ⊢e′ = conv ⊢e (univ (Id-cong (refl (univ 0<1 ⊢Γ))
          (un-univ≡ (subset* D)) (refl (un-univ ⊢B))))
        ⊢e″ = conv ⊢e (univ (Id-cong (refl (univ 0<1 ⊢Γ))
          (un-univ≡ (subset* D)) (un-univ≡ (subset* D₁))))
      in [[ conv (castⱼ (un-univ ⊢A) (un-univ ⊢B) ⊢e (conv ⊢t (sym (subset* D)))) (subset* D₁)
         , ⊢λg
         , (conv* (CastRed*Term′ ⊢B ⊢e (conv ⊢t (sym (subset* D))) D
           ⇨∷* castΠRed* ⊢F ⊢G ⊢e′ ⊢t D₁) (subset* D₁))
           ⇨∷* (PE.subst (λ X → Γ ⊢ cast ⁰ (Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰) (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) e t ⇒ X ∷ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ ι ⁰) g≡g
           (cast-Π (un-univ ⊢F) (un-univ ⊢G) (un-univ ⊢F₁) (un-univ ⊢G₁) ⊢e″ ⊢t) ⇨ (id ⊢λg)) ]]

    g≡g : Γ ⊢ (lam F₁ ▹ g (step id) (var 0) ^ ⁰) ≅ (lam F₁ ▹ g (step id) (var 0) ^ ⁰) ∷ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ]
    g≡g =
      let
        ⊢F₁′ = Twk.wk (Twk.step Twk.id) ⊢Δ₁ ⊢F₁
        ⊢g0 = escapeTerm ([G₁] [ρ₁] ⊢Δ₁ [0]) ([g] [ρ₁] ⊢Δ₁ [0])
        ⊢g0′ = (PE.subst (λ X → Δ₁ ⊢ g (step id) (var 0) ∷ X ^ [ ! , ι ⁰ ]) (wkSingleSubstId G₁) ⊢g0)
        ⊢g0″ = Twk.wkTerm (Twk.lift (Twk.step Twk.id)) (⊢Δ₁ ∙ ⊢F₁′) ⊢g0′
        D : Δ₁ ⊢ (lam (wk1 F₁) ▹ wk1d (g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ⇒* g (step id) (var 0) ∷ wk1d G₁ [ var 0 ] ^ ι ⁰
        D = PE.subst (λ X → Δ₁ ⊢ (lam (wk1 F₁) ▹ wk1d (g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ⇒ X ∷ wk1d G₁ [ var 0 ] ^ ι ⁰) (wkSingleSubstId (g (step id) (var 0)))
          (β-red (≡is≤ PE.refl) (≡is≤ PE.refl) ⊢F₁′ ⊢g0″ (var ⊢Δ₁ here))
          ⇨ id ⊢g0
        [g0] : Δ₁ ⊩⟨ ι ⁰ ⟩ (lam (wk1 F₁) ▹ wk1d (g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ∷ wk1d G₁ [ var 0 ] ^ [ ! , ι ⁰ ] / [G₁] [ρ₁] ⊢Δ₁ [0]
        [g0] = proj₁ (redSubst*Term D ([G₁] [ρ₁] ⊢Δ₁ [0]) ([g] [ρ₁] ⊢Δ₁ [0]))
        x₀ = escapeEqReflTerm ([G₁] [ρ₁] ⊢Δ₁ [0]) [g0]
        x₁ = PE.subst (λ X → Δ₁ ⊢ (lam (wk1 F₁) ▹ wk1d (g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ≅ (lam (wk1 F₁) ▹ wk1d (g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ∷ X ^ [ ! , ι ⁰ ]) (wkSingleSubstId G₁) x₀
      in ≅-η-eq (≡is≤ PE.refl) (≡is≤ PE.refl) ⊢F₁ ⊢λg ⊢λg lamₙ lamₙ x₁

    g∘a≡ga : ∀ {ρ Δ a}
      → ([ρ] : ρ Twk.∷ Δ ⊆ Γ)
      → (⊢Δ : ⊢ Δ)
      → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
      → Δ ⊢ wk ρ (lam F₁ ▹ g (step id) (var 0) ^ ⁰) ∘ a ^ ⁰ ⇒* g ρ a ∷ wk (lift ρ) G₁ [ a ] ^ ι ⁰
    g∘a≡ga {ρ} {Δ} {a} [ρ] ⊢Δ [a] =
      let
        ⊢F₁′ = (Twk.wk [ρ] ⊢Δ ⊢F₁)
        -- this lemma is already in ⊢snde′. maybe refactor?
        x₀ : wk (lift ρ) (b (step id) (fst (wk1 e)) (var 0)) [ a ] PE.≡ b ρ (fst (wk ρ e)) a
        x₀ = PE.trans
          (PE.cong (λ X → cast ⁰ (wk (lift ρ) (wk1 F₁) [ a ]) (wk (lift ρ) (wk1 F) [ a ]) X a)
            (PE.trans (PE.cong (λ X → X [ a ]) (wk-Idsym (lift ρ) (Univ rF ⁰) (wk1 F) (wk1 F₁) (fst (wk1 e))))
              (subst-Idsym (sgSubst a) (Univ rF ⁰) (wk (lift ρ) (wk1 F)) (wk (lift ρ) (wk1 F₁)) (fst (wk (lift ρ) (wk1 e))))))
          (PE.cong₃ (λ X Y Z → cast ⁰ Y X (Idsym (Univ rF ⁰) X Y (fst Z)) a) (irrelevant-subst′ ρ F a) (irrelevant-subst′ ρ F₁ a) (irrelevant-subst′ ρ e a))
        x₁ : wk (lift ρ) (g (step id) (var 0)) [ a ] PE.≡ g ρ a
        x₁ = PE.cong₄ (λ X Y Z T → cast ⁰ X Y Z T)
          (PE.trans (cast-subst-lemma6 ρ G _ a) (PE.cong (λ X → wk (lift ρ) G [ X ]) x₀))
          (PE.cong (λ X → wk (lift ρ) X [ a ]) (wkSingleSubstId G₁))
          (PE.cong (λ X → snd X ∘ a ^ ¹) (irrelevant-subst′ ρ e a))
          (PE.cong₂ (λ X Y → X ∘ Y ^ ⁰) (irrelevant-subst′ ρ t a) x₀)
        x₂ : Δ ∙ (wk ρ F₁) ^ [ rF , ι ⁰ ] ⊢  wk (lift ρ) (g (step id) (var 0)) ∷ wk (lift ρ) G₁ ^ [ ! , ι ⁰ ]
        x₂ = Twk.wkTerm (Twk.lift [ρ]) (⊢Δ ∙ ⊢F₁′) ⊢g0
      in PE.subst (λ X → Δ ⊢ wk ρ (lam F₁ ▹ g (step id) (var 0) ^ ⁰) ∘ a ^ ⁰ ⇒ X ∷ wk (lift ρ) G₁ [ a ] ^ ι ⁰) x₁
        (β-red (≡is≤ PE.refl) (≡is≤ PE.refl) ⊢F₁′ x₂ (escapeTerm ([F₁] [ρ] ⊢Δ) [a]))
        ⇨ id (escapeTerm ([G₁] [ρ] ⊢Δ [a]) ([g] [ρ] ⊢Δ [a]))

    [castΠΠ] : Γ ⊩⟨ ι ⁰ ⟩ cast ⁰ A B e t ∷ B ^ [ ! , ι ⁰ ] / (Πᵣ′ rF ⁰ ⁰ (≡is≤ PE.refl) (≡is≤ PE.refl) F₁ G₁ [[ ⊢B , ⊢ΠF₁G₁ , D₁ ]] ⊢F₁ ⊢G₁ A₁≡A₁ [F₁] [G₁] G₁-ext)
    [castΠΠ] = ((lam F₁ ▹ g (step id) (var 0) ^ ⁰) , Dg , lamₙ , g≡g
        , (λ [ρ] ⊢Δ [a] [a′] [a≡a′] → redSubst*EqTerm (g∘a≡ga [ρ] ⊢Δ [a]) (g∘a≡ga [ρ] ⊢Δ [a′])
             ([G₁] [ρ] ⊢Δ [a]) ([G₁] [ρ] ⊢Δ [a′]) (G₁-ext [ρ] ⊢Δ [a] [a′] [a≡a′])
             ([g] [ρ] ⊢Δ [a]) ([g] [ρ] ⊢Δ [a′]) ([gext] [ρ] ⊢Δ [a] [a′] [a≡a′]))
        , (λ [ρ] ⊢Δ [a] → proj₁ (redSubst*Term (g∘a≡ga [ρ] ⊢Δ [a]) ([G₁] [ρ] ⊢Δ [a]) ([g] [ρ] ⊢Δ [a]))))

module cast-ΠΠ-lemmas-3
       {Γ A₁ A₂ A₃ A₄ F₁ F₂ F₃ F₄ rF G₁ G₂ G₃ G₄ e₁₃ e₂₄ t₁ f₁ t₂ f₂}
       (⊢Γ : ⊢ Γ)

       (⊢A₁ : Γ ⊢ A₁ ^ [ ! , ι ⁰ ])
       (⊢ΠF₁G₁ : Γ ⊢ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₁     : Γ ⊢ A₁ ⇒* Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₁    : Γ ⊢ F₁ ^ [ rF , ι ⁰ ])
       (⊢G₁    : (Γ ∙ F₁ ^ [ rF , ι ⁰ ]) ⊢ G₁ ^ [ ! , ι ⁰ ])
       (A₁≡A₁  : Γ ⊢ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ≅ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₁] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₁ ^ [ rF , ι ⁰ ])
       ([G₁] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ^ [ ! , ι ⁰ ]))
       (G₁-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ≡ wk (lift ρ) G₁ [ b ] ^ [ ! , ι ⁰ ] / ([G₁] [ρ] ⊢Δ [a])))

       (⊢A₂ : Γ ⊢ A₂ ^ [ ! , ι ⁰ ])
       (⊢ΠF₂G₂ : Γ ⊢ Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₂     : Γ ⊢ A₂ ⇒* Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₂    : Γ ⊢ F₂ ^ [ rF , ι ⁰ ])
       (⊢G₂    : (Γ ∙ F₂ ^ [ rF , ι ⁰ ]) ⊢ G₂ ^ [ ! , ι ⁰ ])
       (A₂≡A₂  : Γ ⊢ (Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰) ≅ (Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₂] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₂ ^ [ rF , ι ⁰ ])
       ([G₂] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₂ [ a ] ^ [ ! , ι ⁰ ]))
       (G₂-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₂ [ a ] ≡ wk (lift ρ) G₂ [ b ] ^ [ ! , ι ⁰ ] / ([G₂] [ρ] ⊢Δ [a])))

       (⊢A₃ : Γ ⊢ A₃ ^ [ ! , ι ⁰ ])
       (⊢ΠF₃G₃ : Γ ⊢ Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₃     : Γ ⊢ A₃ ⇒* Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₃    : Γ ⊢ F₃ ^ [ rF , ι ⁰ ])
       (⊢G₃    : (Γ ∙ F₃ ^ [ rF , ι ⁰ ]) ⊢ G₃ ^ [ ! , ι ⁰ ])
       (A₃≡A₃  : Γ ⊢ (Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰) ≅ (Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₃] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₃ ^ [ rF , ι ⁰ ])
       ([G₃] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ a ] ^ [ ! , ι ⁰ ]))
       (G₃-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ a ] ≡ wk (lift ρ) G₃ [ b ] ^ [ ! , ι ⁰ ] / ([G₃] [ρ] ⊢Δ [a])))

       (⊢A₄ : Γ ⊢ A₄ ^ [ ! , ι ⁰ ])
       (⊢ΠF₄G₄ : Γ ⊢ Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₄     : Γ ⊢ A₄ ⇒* Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₄    : Γ ⊢ F₄ ^ [ rF , ι ⁰ ])
       (⊢G₄    : (Γ ∙ F₄ ^ [ rF , ι ⁰ ]) ⊢ G₄ ^ [ ! , ι ⁰ ])
       (A₄≡A₄  : Γ ⊢ (Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰) ≅ (Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₄] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₄ ^ [ rF , ι ⁰ ])
       ([G₄] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₄ [ a ] ^ [ ! , ι ⁰ ]))
       (G₄-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₄ [ a ] ≡ wk (lift ρ) G₄ [ b ] ^ [ ! , ι ⁰ ] / ([G₄] [ρ] ⊢Δ [a])))

       (A₁≡A₂ : Γ ⊢ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ≅ Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (A₃≡A₄ : Γ ⊢ Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰ ≅ Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       ([F₁≡F₂] : ∀ {ρ Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₁ ≡ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
       ([F₃≡F₄] : ∀ {ρ Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₃ ≡ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
       ([G₁≡G₂] : ∀ {ρ Δ a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                  → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
                  → Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ≡ wk (lift ρ) G₂ [ a ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [a])
       ([G₃≡G₄] : ∀ {ρ Δ a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                  → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
                  → Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ a ] ≡ wk (lift ρ) G₄ [ a ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [a])

       (⊢e₁₃ : Γ ⊢ e₁₃ ∷ Id (U ⁰) A₁ A₃ ^ [ % , ι ¹ ])
       (⊢e₂₄ : Γ ⊢ e₂₄ ∷ Id (U ⁰) A₂ A₄ ^ [ % , ι ¹ ])

       (⊢t₁ : Γ ⊢ t₁ ∷ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (Df₁ : Γ ⊢ t₁ ⇒* f₁ ∷ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ ι ⁰)
       ([f₁ext] : ∀ {ρ Δ a b} →
                ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
                ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
                ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
              → Δ ⊩⟨ ι ⁰ ⟩ wk ρ f₁ ∘ a ^ ⁰ ≡ wk ρ f₁ ∘ b ^ ⁰ ∷ wk (lift ρ) G₁ [ a ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [a])
       ([f₁] : ∀ {ρ Δ a}
              → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
              → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
              → Δ ⊩⟨ ι ⁰ ⟩ wk ρ f₁ ∘ a ^ ⁰ ∷ wk (lift ρ) G₁ [ a ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [a])

       (⊢t₂ : Γ ⊢ t₂ ∷ Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (Df₂ : Γ ⊢ t₂ ⇒* f₂ ∷ Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ ι ⁰)
       ([f₂ext] : ∀ {ρ Δ a b} →
                ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
                ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
                ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
              → Δ ⊩⟨ ι ⁰ ⟩ wk ρ f₂ ∘ a ^ ⁰ ≡ wk ρ f₂ ∘ b ^ ⁰ ∷ wk (lift ρ) G₂ [ a ] ^ [ ! , ι ⁰ ] / [G₂] [ρ] ⊢Δ [a])
       ([f₂] : ∀ {ρ Δ a}
              → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
              → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
              → Δ ⊩⟨ ι ⁰ ⟩ wk ρ f₂ ∘ a ^ ⁰ ∷ wk (lift ρ) G₂ [ a ] ^ [ ! , ι ⁰ ] / [G₂] [ρ] ⊢Δ [a])

       ([f₁≡f₂] : ∀ {ρ Δ a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ⁰ ⟩ wk ρ f₁ ∘ a ^ ⁰ ≡ wk ρ f₂ ∘ a ^ ⁰ ∷ wk (lift ρ) G₁ [ a ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [a])

       (recursor₁ : ∀ {ρ Δ x y t e}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
          ([t] : Δ ⊩⟨ ι ⁰ ⟩ t ∷ wk (lift ρ) G₁ [ x ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x])
          (⊢e : Δ ⊢ e ∷ Id (U ⁰) (wk (lift ρ) G₁ [ x ]) (wk (lift ρ) G₃ [ y ]) ^ [ % , ι ¹ ])
          → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk (lift ρ) G₁ [ x ]) (wk (lift ρ) G₃ [ y ]) e t ∷ wk (lift ρ) G₃ [ y ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [y])
       (recursor₂ : ∀ {ρ Δ x y t e}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
          ([t] : Δ ⊩⟨ ι ⁰ ⟩ t ∷ wk (lift ρ) G₂ [ x ] ^ [ ! , ι ⁰ ] / [G₂] [ρ] ⊢Δ [x])
          (⊢e : Δ ⊢ e ∷ Id (U ⁰) (wk (lift ρ) G₂ [ x ]) (wk (lift ρ) G₄ [ y ]) ^ [ % , ι ¹ ])
          → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk (lift ρ) G₂ [ x ]) (wk (lift ρ) G₄ [ y ]) e t ∷ wk (lift ρ) G₄ [ y ] ^ [ ! , ι ⁰ ] / [G₄] [ρ] ⊢Δ [y])
       (extrecursor₁ : ∀ {ρ Δ x x′ y y′ t t′ e e′}
         → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
         → ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([x′] : Δ ⊩⟨ ι ⁰ ⟩ x′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([x≡x′] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ x′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
         → ([y′] : Δ ⊩⟨ ι ⁰ ⟩ y′ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
         → ([y≡y′] : Δ ⊩⟨ ι ⁰ ⟩ y ≡ y′ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
         → ([t] : Δ ⊩⟨ ι ⁰ ⟩ t ∷ wk (lift ρ) G₁ [ x ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x])
         → ([t′] : Δ ⊩⟨ ι ⁰ ⟩ t′ ∷ wk (lift ρ) G₁ [ x′ ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x′])
         → ([t≡t′] : Δ ⊩⟨ ι ⁰ ⟩ t ≡ t′ ∷ wk (lift ρ) G₁ [ x ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x])
         → (⊢e : Δ ⊢ e ∷ Id (U ⁰) (wk (lift ρ) G₁ [ x ]) (wk (lift ρ) G₃ [ y ]) ^ [ % , ι ¹ ])
         → (⊢e′ : Δ ⊢ e′ ∷ Id (U ⁰) (wk (lift ρ) G₁ [ x′ ]) (wk (lift ρ) G₃ [ y′ ]) ^ [ % , ι ¹ ])
         → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk (lift ρ) G₁ [ x ]) (wk (lift ρ) G₃ [ y ]) e t ≡ cast ⁰ (wk (lift ρ) G₁ [ x′ ]) (wk (lift ρ) G₃ [ y′ ]) e′ t′ ∷ wk (lift ρ) G₃ [ y ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [y])
       (extrecursor₂ : ∀ {ρ Δ x x′ y y′ t t′ e e′}
         → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
         → ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
         → ([x′] : Δ ⊩⟨ ι ⁰ ⟩ x′ ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
         → ([x≡x′] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ x′ ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
         → ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
         → ([y′] : Δ ⊩⟨ ι ⁰ ⟩ y′ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
         → ([y≡y′] : Δ ⊩⟨ ι ⁰ ⟩ y ≡ y′ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
         → ([t] : Δ ⊩⟨ ι ⁰ ⟩ t ∷ wk (lift ρ) G₂ [ x ] ^ [ ! , ι ⁰ ] / [G₂] [ρ] ⊢Δ [x])
         → ([t′] : Δ ⊩⟨ ι ⁰ ⟩ t′ ∷ wk (lift ρ) G₂ [ x′ ] ^ [ ! , ι ⁰ ] / [G₂] [ρ] ⊢Δ [x′])
         → ([t≡t′] : Δ ⊩⟨ ι ⁰ ⟩ t ≡ t′ ∷ wk (lift ρ) G₂ [ x ] ^ [ ! , ι ⁰ ] / [G₂] [ρ] ⊢Δ [x])
         → (⊢e : Δ ⊢ e ∷ Id (U ⁰) (wk (lift ρ) G₂ [ x ]) (wk (lift ρ) G₄ [ y ]) ^ [ % , ι ¹ ])
         → (⊢e′ : Δ ⊢ e′ ∷ Id (U ⁰) (wk (lift ρ) G₂ [ x′ ]) (wk (lift ρ) G₄ [ y′ ]) ^ [ % , ι ¹ ])
         → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk (lift ρ) G₂ [ x ]) (wk (lift ρ) G₄ [ y ]) e t ≡ cast ⁰ (wk (lift ρ) G₂ [ x′ ]) (wk (lift ρ) G₄ [ y′ ]) e′ t′ ∷ wk (lift ρ) G₄ [ y ] ^ [ ! , ι ⁰ ] / [G₄] [ρ] ⊢Δ [y])
       (eqrecursor : ∀ {ρ Δ x₁ x₂ x₃ x₄ t₁ t₂ e₁₃ e₂₄}
         → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
         → ([x₁] : Δ ⊩⟨ ι ⁰ ⟩ x₁ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
         → ([x₂] : Δ ⊩⟨ ι ⁰ ⟩ x₂ ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
         → ([G₁x₁≡G₂x₂] : Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ x₁ ] ≡ wk (lift ρ) G₂ [ x₂ ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x₁])
         → ([x₃] : Δ ⊩⟨ ι ⁰ ⟩ x₃ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
         → ([x₄] : Δ ⊩⟨ ι ⁰ ⟩ x₄ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
         → ([G₃x₃≡G₄x₄] : Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ x₃ ] ≡ wk (lift ρ) G₄ [ x₄ ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [x₃])
         → ([t₁] : Δ ⊩⟨ ι ⁰ ⟩ t₁ ∷ wk (lift ρ) G₁ [ x₁ ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x₁])
         → ([t₂] : Δ ⊩⟨ ι ⁰ ⟩ t₂ ∷ wk (lift ρ) G₂ [ x₂ ] ^ [ ! , ι ⁰ ] / [G₂] [ρ] ⊢Δ [x₂])
         → ([t₁≡t₂] : Δ ⊩⟨ ι ⁰ ⟩ t₁ ≡ t₂ ∷ wk (lift ρ) G₁ [ x₁ ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x₁])
         → (⊢e₁₃ : Δ ⊢ e₁₃ ∷ Id (U ⁰) (wk (lift ρ) G₁ [ x₁ ]) (wk (lift ρ) G₃ [ x₃ ]) ^ [ % , ι ¹ ])
         → (⊢e₂₄ : Δ ⊢ e₂₄ ∷ Id (U ⁰) (wk (lift ρ) G₂ [ x₂ ]) (wk (lift ρ) G₄ [ x₄ ]) ^ [ % , ι ¹ ])
         → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk (lift ρ) G₁ [ x₁ ]) (wk (lift ρ) G₃ [ x₃ ]) e₁₃ t₁ ≡ cast ⁰ (wk (lift ρ) G₂ [ x₂ ]) (wk (lift ρ) G₄ [ x₄ ]) e₂₄ t₂ ∷ wk (lift ρ) G₃ [ x₃ ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [x₃])

       ([b₁] : ∀ {ρ Δ e x}
                ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                (⊢e : Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) ^ [ % , ι ¹ ])
                ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
                → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₃) (wk ρ F₁) (Idsym (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) e) x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
       ([bext₁] : ∀ {ρ Δ e e′ x y} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
           → (Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) ^ [ % , ι ¹ ])
           → (Δ ⊢ e′ ∷ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) ^ [ % , ι ¹ ])
           → (Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
           → (Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
           → (Δ ⊩⟨ ι ⁰ ⟩ x ≡ y ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
           → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₃) (wk ρ F₁) (Idsym (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) e) x
             ≡ cast ⁰ (wk ρ F₃) (wk ρ F₁) (Idsym (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) e′) y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
       ([b₂] : ∀ {ρ Δ e x}
                ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                (⊢e : Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) ^ [ % , ι ¹ ])
                ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
                → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₄) (wk ρ F₂) (Idsym (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) e) x ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
       ([bext₂] : ∀ {ρ Δ e e′ x y} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
           → (Δ ⊢ e ∷ Id (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) ^ [ % , ι ¹ ])
           → (Δ ⊢ e′ ∷ Id (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) ^ [ % , ι ¹ ])
           → (Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
           → (Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
           → (Δ ⊩⟨ ι ⁰ ⟩ x ≡ y ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
           → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₄) (wk ρ F₂) (Idsym (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) e) x
             ≡ cast ⁰ (wk ρ F₄) (wk ρ F₂) (Idsym (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) e′) y ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
       ([b₁≡b₂] : ∀ {ρ Δ e₁₃ e₂₄ x₃ x₄} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
            → (Δ ⊢ e₁₃ ∷ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) ^ [ % , ι ¹ ])
            → (Δ ⊢ e₂₄ ∷ Id (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) ^ [ % , ι ¹ ])
            → (Δ ⊩⟨ ι ⁰ ⟩ x₃ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
            → (Δ ⊩⟨ ι ⁰ ⟩ x₄ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
            → (Δ ⊩⟨ ι ⁰ ⟩ x₃ ≡ x₄ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
            → Δ ⊩⟨ ι ⁰ ⟩ cast ⁰ (wk ρ F₃) (wk ρ F₁) (Idsym (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) e₁₃) x₃
              ≡ cast ⁰ (wk ρ F₄) (wk ρ F₂) (Idsym (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) e₂₄) x₄ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)

  where
    module g₁ = cast-ΠΠ-lemmas-2 ⊢Γ ⊢A₁ ⊢ΠF₁G₁ D₁ ⊢F₁ ⊢G₁ A₁≡A₁ [F₁] [G₁] G₁-ext ⊢A₃ ⊢ΠF₃G₃ D₃ ⊢F₃ ⊢G₃ A₃≡A₃ [F₃] [G₃] G₃-ext ⊢e₁₃
                          recursor₁ extrecursor₁ ⊢t₁ Df₁ [f₁ext] [f₁] [b₁] [bext₁]
    module g₂ = cast-ΠΠ-lemmas-2 ⊢Γ ⊢A₂ ⊢ΠF₂G₂ D₂ ⊢F₂ ⊢G₂ A₂≡A₂ [F₂] [G₂] G₂-ext ⊢A₄ ⊢ΠF₄G₄ D₄ ⊢F₄ ⊢G₄ A₄≡A₄ [F₄] [G₄] G₄-ext ⊢e₂₄
                          recursor₂ extrecursor₂ ⊢t₂ Df₂ [f₂ext] [f₂] [b₂] [bext₂]

    [g₁≡g₂] : ∀ {ρ Δ x₃ x₄} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
        → ([x₃] : Δ ⊩⟨ ι ⁰ ⟩ x₃ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
        → ([x₄] : Δ ⊩⟨ ι ⁰ ⟩ x₄ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
        → ([x₃≡x₄] : Δ ⊩⟨ ι ⁰ ⟩ x₃ ≡ x₄ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
        → Δ ⊩⟨ ι ⁰ ⟩ g₁.g ρ x₃ ≡ g₂.g ρ x₄ ∷ wk (lift ρ) G₃ [ x₃ ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [x₃]
    [g₁≡g₂] {ρ} {Δ} {x₃} {x₄} [ρ] ⊢Δ [x₃] [x₄] [x₃≡x₄] =
      let
        [b₁] = [b₁] [ρ] ⊢Δ (Twk.wkTerm [ρ] ⊢Δ g₁.⊢fste) [x₃]
        [b₂] = [b₂] [ρ] ⊢Δ (Twk.wkTerm [ρ] ⊢Δ g₂.⊢fste) [x₄]
        [b₁≡b₂]′ = [b₁≡b₂] [ρ] ⊢Δ (Twk.wkTerm [ρ] ⊢Δ g₁.⊢fste) (Twk.wkTerm [ρ] ⊢Δ g₂.⊢fste) [x₃] [x₄] [x₃≡x₄]
        [b₁:F₂] = convTerm₁ ([F₁] [ρ] ⊢Δ) ([F₂] [ρ] ⊢Δ) ([F₁≡F₂] [ρ] ⊢Δ) [b₁]
        [b₁≡b₂:F₂] = convEqTerm₁ ([F₁] [ρ] ⊢Δ) ([F₂] [ρ] ⊢Δ) ([F₁≡F₂] [ρ] ⊢Δ) [b₁≡b₂]′
        [G₁b₁≡G₂b₂] = transEq ([G₁] [ρ] ⊢Δ [b₁]) ([G₂] [ρ] ⊢Δ [b₁:F₂]) ([G₂] [ρ] ⊢Δ [b₂])
          ([G₁≡G₂] [ρ] ⊢Δ [b₁]) (G₂-ext [ρ] ⊢Δ [b₁:F₂] [b₂] [b₁≡b₂:F₂])
        [x₃:F₄] = convTerm₁ ([F₃] [ρ] ⊢Δ) ([F₄] [ρ] ⊢Δ) ([F₃≡F₄] [ρ] ⊢Δ) [x₃]
        [x₃≡x₄:F₄] = convEqTerm₁ ([F₃] [ρ] ⊢Δ) ([F₄] [ρ] ⊢Δ) ([F₃≡F₄] [ρ] ⊢Δ) [x₃≡x₄]
        [G₃x₃≡G₄x₄] = transEq ([G₃] [ρ] ⊢Δ [x₃]) ([G₄] [ρ] ⊢Δ [x₃:F₄]) ([G₄] [ρ] ⊢Δ [x₄])
          ([G₃≡G₄] [ρ] ⊢Δ [x₃]) (G₄-ext [ρ] ⊢Δ [x₃:F₄] [x₄] [x₃≡x₄:F₄])
        [t₁] , [t₁≡f₁b₁] = redSubst*Term (appRed* (escapeTerm ([F₁] [ρ] ⊢Δ) [b₁]) (Twk.wkRed*Term [ρ] ⊢Δ Df₁))
          ([G₁] [ρ] ⊢Δ [b₁]) ([f₁] [ρ] ⊢Δ [b₁])
        [t₂] , [t₂≡f₂b₂] = redSubst*Term (appRed* (escapeTerm ([F₂] [ρ] ⊢Δ) [b₂]) (Twk.wkRed*Term [ρ] ⊢Δ Df₂))
          ([G₂] [ρ] ⊢Δ [b₂]) ([f₂] [ρ] ⊢Δ [b₂])
        [t₁≡f₂b₁] = transEqTerm ([G₁] [ρ] ⊢Δ [b₁]) [t₁≡f₁b₁] ([f₁≡f₂] [ρ] ⊢Δ [b₁])
        [f₂b₁≡t₂] = symEqTerm ([G₂] [ρ] ⊢Δ [b₂]) (transEqTerm ([G₂] [ρ] ⊢Δ [b₂]) [t₂≡f₂b₂] ([f₂ext] [ρ] ⊢Δ [b₂] [b₁:F₂] (symEqTerm ([F₂] [ρ] ⊢Δ) [b₁≡b₂:F₂])))
        [t₁≡t₂] = transEqTerm ([G₁] [ρ] ⊢Δ [b₁]) [t₁≡f₂b₁] (convEqTerm₂ ([G₁] [ρ] ⊢Δ [b₁]) ([G₂] [ρ] ⊢Δ [b₂]) [G₁b₁≡G₂b₂] [f₂b₁≡t₂])
        x = eqrecursor [ρ] ⊢Δ [b₁] [b₂] [G₁b₁≡G₂b₂] [x₃] [x₄] [G₃x₃≡G₄x₄] [t₁] [t₂] [t₁≡t₂]
                       (g₁.⊢snde′ [ρ] ⊢Δ (escapeTerm ([F₃] [ρ] ⊢Δ) [x₃])) (g₂.⊢snde′ [ρ] ⊢Δ (escapeTerm ([F₄] [ρ] ⊢Δ) [x₄]))
      in x

    g₁≡g₂ : Γ ⊢ (lam F₃ ▹ g₁.g (step id) (var 0) ^ ⁰) ≅ (lam F₄ ▹ g₂.g (step id) (var 0) ^ ⁰) ∷ Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ]
    g₁≡g₂ =
      let
        Δ₁ = g₁.Δ₁
        ⊢Δ₁ = g₁.⊢Δ₁
        [ρ₁] = g₁.[ρ₁]
        ⊢F₃′ = Twk.wk (Twk.step Twk.id) ⊢Δ₁ ⊢F₃
        ⊢g₁0 = escapeTerm ([G₃] [ρ₁] ⊢Δ₁ g₁.[0]) (g₁.[g] [ρ₁] ⊢Δ₁ g₁.[0])
        ⊢g₁0′ = (PE.subst (λ X → Δ₁ ⊢ g₁.g (step id) (var 0) ∷ X ^ [ ! , ι ⁰ ]) (wkSingleSubstId G₃) ⊢g₁0)
        ⊢g₁0″ = Twk.wkTerm (Twk.lift (Twk.step Twk.id)) (⊢Δ₁ ∙ ⊢F₃′) ⊢g₁0′
        ⊢F₄′ = Twk.wk (Twk.step Twk.id) ⊢Δ₁ ⊢F₄
        ⊢g₂0 = escapeTerm ([G₄] g₂.[ρ₁] g₂.⊢Δ₁ g₂.[0]) (g₂.[g] g₂.[ρ₁] g₂.⊢Δ₁ g₂.[0])
        ⊢g₂0′ = (PE.subst (λ X → g₂.Δ₁ ⊢ g₂.g (step id) (var 0) ∷ X ^ [ ! , ι ⁰ ]) (wkSingleSubstId G₄) ⊢g₂0)
        ⊢g₂0″ = Twk.wkTerm (Twk.lift (Twk.step Twk.id)) (⊢Δ₁ ∙ ⊢F₄′) ⊢g₂0′
        D₁ : Δ₁ ⊢ (lam (wk1 F₃) ▹ wk1d (g₁.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ⇒* g₁.g (step id) (var 0) ∷ wk1d G₃ [ var 0 ] ^ ι ⁰
        D₁ = PE.subst (λ X → Δ₁ ⊢ (lam (wk1 F₃) ▹ wk1d (g₁.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ⇒ X ∷ wk1d G₃ [ var 0 ] ^ ι ⁰)
          (wkSingleSubstId (g₁.g (step id) (var 0))) (β-red (≡is≤ PE.refl) (≡is≤ PE.refl) ⊢F₃′ ⊢g₁0″ (var ⊢Δ₁ here))
          ⇨ id ⊢g₁0
        F₃≡F₄ = escapeEq ([F₃] [ρ₁] ⊢Δ₁) ([F₃≡F₄] [ρ₁] ⊢Δ₁)
        [0:F₄] : Δ₁ ⊩⟨ ι ⁰ ⟩ var 0 ∷ wk (step id) F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ₁] ⊢Δ₁
        [0:F₄] = neuTerm ([F₄] [ρ₁] ⊢Δ₁) (var 0) (conv (var ⊢Δ₁ here) (≅-eq F₃≡F₄)) (~-var (conv (var ⊢Δ₁ here) (≅-eq F₃≡F₄)))
        D₂ : Δ₁ ⊢ (lam (wk1 F₄) ▹ wk1d (g₂.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ⇒* g₂.g (step id) (var 0) ∷ wk1d G₄ [ var 0 ] ^ ι ⁰
        D₂ = PE.subst (λ X → Δ₁ ⊢ (lam (wk1 F₄) ▹ wk1d (g₂.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ⇒ X ∷ wk1d G₄ [ var 0 ] ^ ι ⁰)
          (wkSingleSubstId (g₂.g (step id) (var 0))) (β-red (≡is≤ PE.refl) (≡is≤ PE.refl) ⊢F₄′ ⊢g₂0″ (conv (var ⊢Δ₁ here) (≅-eq F₃≡F₄)))
          ⇨ id (escapeTerm ([G₄] [ρ₁] ⊢Δ₁ [0:F₄]) (g₂.[g] [ρ₁] ⊢Δ₁ [0:F₄]))
        [g₁0≡g₁] : Δ₁ ⊩⟨ ι ⁰ ⟩ (lam (wk1 F₃) ▹ wk1d (g₁.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ≡ g₁.g (step id) (var 0) ∷ wk1d G₃ [ var 0 ] ^ [ ! , ι ⁰ ] / [G₃] [ρ₁] ⊢Δ₁ g₁.[0]
        [g₁0≡g₁] = proj₂ (redSubst*Term D₁ ([G₃] [ρ₁] ⊢Δ₁ g₁.[0]) (g₁.[g] [ρ₁] ⊢Δ₁ g₁.[0]))
        [g₂0≡g₂] : Δ₁ ⊩⟨ ι ⁰ ⟩ (lam (wk1 F₄) ▹ wk1d (g₂.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ≡ g₂.g (step id) (var 0) ∷ wk1d G₄ [ var 0 ] ^ [ ! , ι ⁰ ] / [G₄] [ρ₁] ⊢Δ₁ [0:F₄]
        [g₂0≡g₂] = proj₂ (redSubst*Term D₂ ([G₄] [ρ₁] ⊢Δ₁ [0:F₄]) (g₂.[g] [ρ₁] ⊢Δ₁ [0:F₄]))
        [g₁≡g₂]′ : Δ₁ ⊩⟨ ι ⁰ ⟩ g₁.g (step id) (var 0) ≡ g₂.g (step id) (var 0) ∷ wk1d G₃ [ var 0 ] ^ [ ! , ι ⁰ ] / [G₃] [ρ₁] ⊢Δ₁ g₁.[0]
        [g₁≡g₂]′ = [g₁≡g₂] [ρ₁] ⊢Δ₁ g₁.[0] (convTerm₁ ([F₃] [ρ₁] ⊢Δ₁) ([F₄] [ρ₁] ⊢Δ₁) ([F₃≡F₄] [ρ₁] ⊢Δ₁) g₁.[0]) (reflEqTerm ([F₃] [ρ₁] ⊢Δ₁) g₁.[0])
        [g₁0≡g₂0] = transEqTerm ([G₃] [ρ₁] ⊢Δ₁ g₁.[0]) (transEqTerm ([G₃] [ρ₁] ⊢Δ₁ g₁.[0]) [g₁0≡g₁] [g₁≡g₂]′)
          (convEqTerm₂ ([G₃] [ρ₁] ⊢Δ₁ g₁.[0]) ([G₄] [ρ₁] ⊢Δ₁ [0:F₄]) ([G₃≡G₄] [ρ₁] ⊢Δ₁ g₁.[0]) (symEqTerm ([G₄] [ρ₁] ⊢Δ₁ [0:F₄]) [g₂0≡g₂]))
        x₀ = escapeTermEq ([G₃] [ρ₁] ⊢Δ₁ g₁.[0]) [g₁0≡g₂0]
        x₁ = PE.subst (λ X → Δ₁ ⊢ (lam (wk1 F₃) ▹ wk1d (g₁.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ≅ (lam (wk1 F₄) ▹ wk1d (g₂.g (step id) (var 0)) ^ ⁰) ∘ (var 0) ^ ⁰ ∷ X ^ [ ! , ι ⁰ ]) (wkSingleSubstId G₃) x₀
      in ≅-η-eq (≡is≤ PE.refl) (≡is≤ PE.refl) ⊢F₃ g₁.⊢λg (conv g₂.⊢λg (sym (≅-eq A₃≡A₄))) lamₙ lamₙ x₁

    [g₁a≡g₂a] : ∀ {ρ Δ a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
        → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
        → (Δ ⊩⟨ ι ⁰ ⟩ wk ρ (lam F₃ ▹ g₁.g (step id) (var 0) ^ ⁰) ∘ a ^ ⁰ ≡ wk ρ (lam F₄ ▹ g₂.g (step id) (var 0) ^ ⁰) ∘ a ^ ⁰
            ∷ wk (lift ρ) G₃ [ a ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [a])
    [g₁a≡g₂a] [ρ] ⊢Δ [a] =
      let
        [a]′ = convTerm₁ ([F₃] [ρ] ⊢Δ) ([F₄] [ρ] ⊢Δ) ([F₃≡F₄] [ρ] ⊢Δ) [a]
        [a≡a] = reflEqTerm ([F₃] [ρ] ⊢Δ) [a]
      in redSubst*EqTerm (g₁.g∘a≡ga [ρ] ⊢Δ [a]) (g₂.g∘a≡ga [ρ] ⊢Δ [a]′)
         ([G₃] [ρ] ⊢Δ [a]) ([G₄] [ρ] ⊢Δ [a]′) ([G₃≡G₄] [ρ] ⊢Δ [a])
         (g₁.[g] [ρ] ⊢Δ [a]) (g₂.[g] [ρ] ⊢Δ [a]′) ([g₁≡g₂] [ρ] ⊢Δ [a] [a]′ [a≡a])


module string where

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

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

postulate
  Pair : (A B : Set) → Set
  pair : {A B : Set} → A → B → Pair A B
  pair-fst : {A B : Set} → Pair A B → A
  pair-snd : {A B : Set} → Pair A B → B

{-# COMPILE GHC Pair = type (,)           #-}
{-# COMPILE GHC pair = \ _ _ a b -> (a, b) #-}
{-# COMPILE GHC pair-fst = \ _ _ p -> fst p #-}
{-# COMPILE GHC pair-snd = \ _ _ p -> snd p #-}

postulate
  string : Set
  stringUncons   : string → maybe (Pair char string)
  stringFoldl : ∀{A : Set} → (A → char → A) → A → string → A
  stringFoldr : ∀{A : Set} → (char → A → A) → A → string → A

{-# BUILTIN STRING string #-}
{-# COMPILE GHC stringUncons = Data.Text.uncons #-}
{-# COMPILE GHC stringFoldl = \ x -> Data.Text.foldl #-}
{-# COMPILE GHC stringFoldr = \ x -> Data.Text.foldr #-}

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-uncons : string → maybe (char × string)
string-uncons x with stringUncons x
string-uncons x | nothing = nothing
string-uncons x | just x₁ = just (pair-fst x₁ , pair-snd x₁)

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)