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)


module STLC2.Kovacs.Convertibility where

open import STLC2.Kovacs.Substitution public

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

-- Convertibility (_~_ ; ~refl ; _~⁻¹ ; lam ; app ; β ; η)
infix 3 _∼_
data _∼_ : ∀ {Γ A} → Γ ⊢ A → Γ ⊢ A → Set
  where
    refl∼    : ∀ {Γ A} → {M : Γ ⊢ A}
                       → M ∼ M

    _⁻¹∼     : ∀ {Γ A} → {M₁ M₂ : Γ ⊢ A}
                       → (p : M₁ ∼ M₂)
                       → M₂ ∼ M₁

    _⦙∼_     : ∀ {Γ A} → {M₁ M₂ M₃ : Γ ⊢ A}
                       → (p : M₁ ∼ M₂) (q : M₂ ∼ M₃)
                       → M₁ ∼ M₃

    ƛ∼       : ∀ {Γ A B} → {M₁ M₂ : Γ , A ⊢ B}
                         → (p : M₁ ∼ M₂)
                         → ƛ M₁ ∼ ƛ M₂

    _∙∼_     : ∀ {Γ A B} → {M₁ M₂ : Γ ⊢ A ⇒ B} {N₁ N₂ : Γ ⊢ A}
                         → (p : M₁ ∼ M₂) (q : N₁ ∼ N₂)
                         → M₁ ∙ N₁ ∼ M₂ ∙ N₂

    _,∼_     : ∀ {Γ A B} → {M₁ M₂ : Γ ⊢ A} {N₁ N₂ : Γ ⊢ B}
                         → (p : M₁ ∼ M₂) (q : N₁ ∼ N₂)
                         → M₁ , N₁ ∼ M₂ , N₂

    π₁∼      : ∀ {Γ A B} → {M₁ M₂ : Γ ⊢ A ⩕ B}
                         → (p : M₁ ∼ M₂)
                         → π₁ M₁ ∼ π₁ M₂

    π₂∼      : ∀ {Γ A B} → {M₁ M₂ : Γ ⊢ A ⩕ B}
                         → (p : M₁ ∼ M₂)
                         → π₂ M₁ ∼ π₂ M₂

    φ∼       : ∀ {Γ C} → {M₁ M₂ : Γ ⊢ ⫫}
                       → (p : M₁ ∼ M₂)
                       → φ {C = C} M₁ ∼ φ M₂

    ι₁∼      : ∀ {Γ A B} → {M₁ M₂ : Γ ⊢ A}
                         → (p : M₁ ∼ M₂)
                         → ι₁ {B = B} M₁ ∼ ι₁ M₂

    ι₂∼      : ∀ {Γ A B} → {M₁ M₂ : Γ ⊢ B}
                         → (p : M₁ ∼ M₂)
                         → ι₂ {A = A} M₁ ∼ ι₂ M₂

    _⁇∼_∥∼_  : ∀ {Γ A B C} → {M₁ M₂ : Γ ⊢ A ⩖ B}
                              {N₁₁ N₁₂ : Γ , A ⊢ C} {N₂₁ N₂₂ : Γ , B ⊢ C}
                           → (p : M₁ ∼ M₂) (q₁ : N₁₁ ∼ N₁₂) (q₂ : N₂₁ ∼ N₂₂)
                           → M₁ ⁇ N₁₁ ∥ N₂₁ ∼ M₂ ⁇ N₁₂ ∥ N₂₂

    red⇒    : ∀ {Γ A B} → (M : Γ , A ⊢ B) (N : Γ ⊢ A)
                         → (ƛ M) ∙ N ∼ cut N M

    red⩕₁    : ∀ {Γ A B} → (M : Γ ⊢ A) (N : Γ ⊢ B)
                         → π₁ (M , N) ∼ M

    red⩕₂    : ∀ {Γ A B} → (M : Γ ⊢ A) (N : Γ ⊢ B)
                         → π₂ (M , N) ∼ N

    red⩖₁    : ∀ {Γ A B C} → (M : Γ ⊢ A) (N₁ : Γ , A ⊢ C) (N₂ : Γ , B ⊢ C)
                           → ι₁ M ⁇ N₁ ∥ N₂ ∼ cut M N₁

    red⩖₂    : ∀ {Γ A B C} → (M : Γ ⊢ B) (N₁ : Γ , A ⊢ C) (N₂ : Γ , B ⊢ C)
                           → ι₂ M ⁇ N₁ ∥ N₂ ∼ cut M N₂

    exp⇒    : ∀ {Γ A B} → (M : Γ ⊢ A ⇒ B)
                         → M ∼ ƛ (wk M ∙ 0)

    exp⩕     : ∀ {Γ A B} → (M : Γ ⊢ A ⩕ B)
                         → M ∼ π₁ M , π₂ M

    exp⫪    : ∀ {Γ} → (M : Γ ⊢ ⫪)
                     → M ∼ τ

    exp⩖     : ∀ {Γ A B} → (M : Γ ⊢ A ⩖ B)
                         → M ∼ M ⁇ ι₁ 0 ∥ ι₂ 0

    comm⫫∙  : ∀ {Γ A B} → (M : Γ ⊢ ⫫) (N : Γ ⊢ A)
                         → _∙_ {A = A} {B} (φ M) N ∼ φ M

    comm⫫π₁ : ∀ {Γ A B} → (M : Γ ⊢ ⫫)
                         → π₁ {A = A} {B} (φ M) ∼ φ M

    comm⫫π₂ : ∀ {Γ A B} → (M : Γ ⊢ ⫫)
                         → π₂ {A = A} {B} (φ M) ∼ φ M

    comm⫫φ  : ∀ {Γ C} → (M : Γ ⊢ ⫫)
                       → φ {C = C} (φ M) ∼ φ M

    comm⫫⁇∥ : ∀ {Γ A B C} → (M : Γ ⊢ ⫫) (N₁ : Γ , A ⊢ C) (N₂ : Γ , B ⊢ C)
                           → φ M ⁇ N₁ ∥ N₂ ∼ φ M

    comm⩖∙   : ∀ {Γ A B C D} → (M : Γ ⊢ A ⩖ B)
                                (N₁ : Γ , A ⊢ C ⇒ D)
                                (N₂ : Γ , B ⊢ C ⇒ D)
                                (O : Γ ⊢ C)
                             → (M ⁇ N₁ ∥ N₂) ∙ O ∼
                                M ⁇ (N₁ ∙ wk O) ∥ (N₂ ∙ wk O)

    comm⩖π₁  : ∀ {Γ A B C D} → (M : Γ ⊢ A ⩖ B)
                                (N₁ : Γ , A ⊢ C ⩕ D)
                                (N₂ : Γ , B ⊢ C ⩕ D)
                             → π₁ (M ⁇ N₁ ∥ N₂) ∼
                                M ⁇ (π₁ N₁) ∥ (π₁ N₂)

    comm⩖π₂  : ∀ {Γ A B C D} → (M : Γ ⊢ A ⩖ B)
                                (N₁ : Γ , A ⊢ C ⩕ D)
                                (N₂ : Γ , B ⊢ C ⩕ D)
                             → π₂ (M ⁇ N₁ ∥ N₂) ∼
                                M ⁇ (π₂ N₁) ∥ (π₂ N₂)

    comm⩖φ   : ∀ {Γ A B C} → (M : Γ ⊢ A ⩖ B)
                              (N₁ : Γ , A ⊢ ⫫)
                              (N₂ : Γ , B ⊢ ⫫)
                           → φ {C = C} (M ⁇ N₁ ∥ N₂) ∼
                              M ⁇ (φ N₁) ∥ (φ N₂)

    comm⩖⁇∥  : ∀ {Γ A B C D E} → (M : Γ ⊢ A ⩖ B)
                                  (N₁ : Γ , A ⊢ C ⩖ D)
                                  (N₂ : Γ , B ⊢ C ⩖ D)
                                  (O₁ : Γ , C ⊢ E)
                                  (O₂ : Γ , D ⊢ E)
                               → (M ⁇ N₁ ∥ N₂) ⁇ O₁ ∥ O₂ ∼
                                  M ⁇ (N₁ ⁇ liftwk O₁ ∥ liftwk O₂)
                                    ∥ (N₂ ⁇ liftwk O₁ ∥ liftwk O₂)

≡→∼ : ∀ {Γ A} → {M₁ M₂ : Γ ⊢ A}
               → M₁ ≡ M₂
               → M₁ ∼ M₂
≡→∼ refl = refl∼

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

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

renwk : ∀ {Γ Γ′ A B} → (η : Γ′ ⊇ Γ) (M : Γ ⊢ A)
                     → (wk {B} ∘ ren η) M ≡
                        (ren (liftₑ η) ∘ wk) M
renwk η M = ren○ (wkₑ idₑ) η M ⁻¹
          ⦙ (λ η′ → ren (wkₑ η′) M) & ( rid○ η
                                       ⦙ lid○ η ⁻¹
                                       )
          ⦙ ren○ (liftₑ η) (wkₑ idₑ) M

renliftwk : ∀ {Γ Γ′ A B C} → (η : Γ′ ⊇ Γ) (M : Γ , A ⊢ B)
                           → (liftwk {C} ∘ ren (liftₑ η)) M ≡
                              (ren (liftₑ (liftₑ η)) ∘ liftwk) M
renliftwk η M = ren○ (liftₑ (wkₑ idₑ)) (liftₑ η) M ⁻¹
              ⦙ (λ η′ → ren (liftₑ (wkₑ η′)) M) & ( rid○ η
                                                   ⦙ lid○ η ⁻¹
                                                   )
              ⦙ ren○ (liftₑ (liftₑ η)) (liftₑ (wkₑ idₑ)) M

rencut : ∀ {Γ Γ′ A B} → (η : Γ′ ⊇ Γ) (M : Γ ⊢ A) (N : Γ , A ⊢ B)
                      → (cut (ren η M) ∘ ren (liftₑ η)) N ≡
                         (ren η ∘ cut M) N
rencut η M N = sub◑ (idₛ , ren η M) (liftₑ η) N ⁻¹
             ⦙ (λ σ → sub (σ , ren η M) N) & ( rid◑ η
                                              ⦙ lid◐ η ⁻¹
                                              )
             ⦙ sub◐ η (idₛ , M) N

-- (~ₑ)
ren∼ : ∀ {Γ Γ′ A} → {M₁ M₂ : Γ ⊢ A}
                  → (η : Γ′ ⊇ Γ) → M₁ ∼ M₂
                  → ren η M₁ ∼ ren η M₂

ren∼ η refl∼                   = refl∼
ren∼ η (p ⁻¹∼)                 = ren∼ η p ⁻¹
ren∼ η (p ⦙∼ q)                = ren∼ η p ⦙ ren∼ η q
ren∼ η (ƛ∼ p)                  = ƛ∼ (ren∼ (liftₑ η) p)
ren∼ η (p ∙∼ q)                = ren∼ η p ∙∼ ren∼ η q
ren∼ η (p ,∼ q)                = ren∼ η p ,∼ ren∼ η q
ren∼ η (π₁∼ p)                 = π₁∼ (ren∼ η p)
ren∼ η (π₂∼ p)                 = π₂∼ (ren∼ η p)
ren∼ η (φ∼ p)                  = φ∼ (ren∼ η p)
ren∼ η (ι₁∼ p)                 = ι₁∼ (ren∼ η p)
ren∼ η (ι₂∼ p)                 = ι₂∼ (ren∼ η p)
ren∼ η (p ⁇∼ q₁ ∥∼ q₂)         = ren∼ η p ⁇∼ ren∼ (liftₑ η) q₁
                                          ∥∼ ren∼ (liftₑ η) q₂

ren∼ η (red⇒ M N)
  = coe (((ƛ (ren (liftₑ η) M) ∙ ren η N) ∼_)
         & rencut η N M)
        (red⇒ (ren (liftₑ η) M) (ren η N))

ren∼ η (red⩕₁ M N)             = red⩕₁ (ren η M) (ren η N)
ren∼ η (red⩕₂ M N)             = red⩕₂ (ren η M) (ren η N)

ren∼ η (red⩖₁ M N₁ N₂)
  = coe (((ι₁ (ren η M) ⁇ ren (liftₑ η) N₁
                        ∥ ren (liftₑ η) N₂) ∼_)
         & rencut η M N₁)
        (red⩖₁ (ren η M)
               (ren (liftₑ η) N₁)
               (ren (liftₑ η) N₂))

ren∼ η (red⩖₂ M N₁ N₂)
  = coe (((ι₂ (ren η M) ⁇ ren (liftₑ η) N₁
                        ∥ ren (liftₑ η) N₂) ∼_)
         & rencut η M N₂)
        (red⩖₂ (ren η M)
               (ren (liftₑ η) N₁)
               (ren (liftₑ η) N₂))

ren∼ η (exp⇒ M)
  = coe ((λ M′ → ren η M ∼ ƛ (M′ ∙ 0))
         & renwk η M)
        (exp⇒ (ren η M))

ren∼ η (exp⩕ M)                = exp⩕ (ren η M)
ren∼ η (exp⫪ M)               = exp⫪ (ren η M)
ren∼ η (exp⩖ M)                = exp⩖ (ren η M)
ren∼ η (comm⫫∙ M N)           = comm⫫∙ (ren η M) (ren η N)
ren∼ η (comm⫫π₁ M)            = comm⫫π₁ (ren η M)
ren∼ η (comm⫫π₂ M)            = comm⫫π₂ (ren η M)
ren∼ η (comm⫫φ M)             = comm⫫φ (ren η M)
ren∼ η (comm⫫⁇∥ M N₁ N₂)      = comm⫫⁇∥ (ren η M)
                                          (ren (liftₑ η) N₁)
                                          (ren (liftₑ η) N₂)

ren∼ η (comm⩖∙ M N₁ N₂ O)
  = coe ((((ren η M ⁇ ren (liftₑ η) N₁
                    ∥ ren (liftₑ η) N₂) ∙ ren η O ) ∼_)
         & ((λ N₁′ N₂′ → ren η M ⁇ N₁′ ∥ N₂′)
            & ((λ O′ → ren (liftₑ η) N₁ ∙ O′)
               & renwk η O)
            ⊗ ((λ O′ → ren (liftₑ η) N₂ ∙ O′)
               & renwk η O)))
        (comm⩖∙ (ren η M)
                (ren (liftₑ η) N₁)
                (ren (liftₑ η) N₂)
                (ren η O))

ren∼ η (comm⩖π₁ M N₁ N₂)       = comm⩖π₁ (ren η M)
                                         (ren (liftₑ η) N₁)
                                         (ren (liftₑ η) N₂)
ren∼ η (comm⩖π₂ M N₁ N₂)       = comm⩖π₂ (ren η M)
                                         (ren (liftₑ η) N₁)
                                         (ren (liftₑ η) N₂)
ren∼ η (comm⩖φ M N₁ N₂)        = comm⩖φ (ren η M)
                                        (ren (liftₑ η) N₁)
                                        (ren (liftₑ η) N₂)

ren∼ η (comm⩖⁇∥ M N₁ N₂ O₁ O₂)
  = coe ((((ren η M ⁇ ren (liftₑ η) N₁
                    ∥ ren (liftₑ η) N₂) ⁇ ren (liftₑ η) O₁
                                        ∥ ren (liftₑ η) O₂) ∼_)
         & ((λ N₁′ N₂′ → ren η M ⁇ N₁′ ∥ N₂′)
            & ((λ O₁′ O₂′ → ren (liftₑ η) N₁ ⁇ O₁′ ∥ O₂′)
               & renliftwk η O₁ ⊗ renliftwk η O₂)
            ⊗ ((λ O₁′ O₂′ → ren (liftₑ η) N₂ ⁇ O₁′ ∥ O₂′)
               & renliftwk η O₁ ⊗ renliftwk η O₂)))
        (comm⩖⁇∥ (ren η M)
                 (ren (liftₑ η) N₁)
                 (ren (liftₑ η) N₂)
                 (ren (liftₑ η) O₁)
                 (ren (liftₑ η) O₂))

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


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

module Definition.Typed.Properties where

open import Definition.Untyped
open import Definition.Typed

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

-- Escape context extraction

wfTerm : ∀ {Γ A t} → Γ ⊢ t ∷ A → ⊢ Γ
wfTerm (ℕⱼ ⊢Γ) = ⊢Γ
wfTerm (Πⱼ F ▹ G) = wfTerm F
wfTerm (var ⊢Γ x₁) = ⊢Γ
wfTerm (lamⱼ F t) with wfTerm t
wfTerm (lamⱼ F t) | ⊢Γ ∙ F′ = ⊢Γ
wfTerm (g ∘ⱼ a) = wfTerm a
wfTerm (zeroⱼ ⊢Γ) = ⊢Γ
wfTerm (sucⱼ n) = wfTerm n
wfTerm (natrecⱼ F z s n) = wfTerm z
wfTerm (conv t A≡B) = wfTerm t

wf : ∀ {Γ A} → Γ ⊢ A → ⊢ Γ
wf (ℕⱼ ⊢Γ) = ⊢Γ
wf (Uⱼ ⊢Γ) = ⊢Γ
wf (Πⱼ F ▹ G) = wf F
wf (univ A) = wfTerm A

wfEqTerm : ∀ {Γ A t u} → Γ ⊢ t ≡ u ∷ A → ⊢ Γ
wfEqTerm (refl t) = wfTerm t
wfEqTerm (sym t≡u) = wfEqTerm t≡u
wfEqTerm (trans t≡u u≡r) = wfEqTerm t≡u
wfEqTerm (conv t≡u A≡B) = wfEqTerm t≡u
wfEqTerm (Π-cong F F≡H G≡E) = wfEqTerm F≡H
wfEqTerm (app-cong f≡g a≡b) = wfEqTerm f≡g
wfEqTerm (β-red F t a) = wfTerm a
wfEqTerm (η-eq F f g f0≡g0) = wfTerm f
wfEqTerm (suc-cong n) = wfEqTerm n
wfEqTerm (natrec-cong F≡F′ z≡z′ s≡s′ n≡n′) = wfEqTerm z≡z′
wfEqTerm (natrec-zero F z s) = wfTerm z
wfEqTerm (natrec-suc n F z s) = wfTerm n

wfEq : ∀ {Γ A B} → Γ ⊢ A ≡ B → ⊢ Γ
wfEq (univ A≡B) = wfEqTerm A≡B
wfEq (refl A) = wf A
wfEq (sym A≡B) = wfEq A≡B
wfEq (trans A≡B B≡C) = wfEq A≡B
wfEq (Π-cong F F≡H G≡E) = wfEq F≡H

-- Reduction is a subset of conversion

subsetTerm : ∀ {Γ A t u} → Γ ⊢ t ⇒ u ∷ A → Γ ⊢ t ≡ u ∷ A
subsetTerm (natrec-subst F z s n⇒n′) =
  natrec-cong (refl F) (refl z) (refl s) (subsetTerm n⇒n′)
subsetTerm (natrec-zero F z s) = natrec-zero F z s
subsetTerm (natrec-suc n F z s) = natrec-suc n F z s
subsetTerm (app-subst t⇒u a) = app-cong (subsetTerm t⇒u) (refl a)
subsetTerm (β-red A t a) = β-red A t a
subsetTerm (conv t⇒u A≡B) = conv (subsetTerm t⇒u) A≡B

subset : ∀ {Γ A B} → Γ ⊢ A ⇒ B → Γ ⊢ A ≡ B
subset (univ A⇒B) = univ (subsetTerm A⇒B)

subset*Term : ∀ {Γ A t u} → Γ ⊢ t ⇒* u ∷ A → Γ ⊢ t ≡ u ∷ A
subset*Term (id t) = refl t
subset*Term (t⇒t′ ⇨ t⇒*u) = trans (subsetTerm t⇒t′) (subset*Term t⇒*u)

subset* : ∀ {Γ A B} → Γ ⊢ A ⇒* B → Γ ⊢ A ≡ B
subset* (id A) = refl A
subset* (A⇒A′ ⇨ A′⇒*B) = trans (subset A⇒A′) (subset* A′⇒*B)

-- Can extract left-part of a reduction

redFirstTerm : ∀ {Γ t u A} → Γ ⊢ t ⇒ u ∷ A → Γ ⊢ t ∷ A
redFirstTerm (conv t⇒u A≡B) = conv (redFirstTerm t⇒u) A≡B
redFirstTerm (app-subst t⇒u a) = (redFirstTerm t⇒u) ∘ⱼ a
redFirstTerm (β-red A t a) = (lamⱼ A t) ∘ⱼ a
redFirstTerm (natrec-subst F z s n⇒n′) = natrecⱼ F z s (redFirstTerm n⇒n′)
redFirstTerm (natrec-zero F z s) = natrecⱼ F z s (zeroⱼ (wfTerm z))
redFirstTerm (natrec-suc n F z s) = natrecⱼ F z s (sucⱼ n)

redFirst : ∀ {Γ A B} → Γ ⊢ A ⇒ B → Γ ⊢ A
redFirst (univ A⇒B) = univ (redFirstTerm A⇒B)

redFirst*Term : ∀ {Γ t u A} → Γ ⊢ t ⇒* u ∷ A → Γ ⊢ t ∷ A
redFirst*Term (id t) = t
redFirst*Term (t⇒t′ ⇨ t′⇒*u) = redFirstTerm t⇒t′

redFirst* : ∀ {Γ A B} → Γ ⊢ A ⇒* B → Γ ⊢ A
redFirst* (id A) = A
redFirst* (A⇒A′ ⇨ A′⇒*B) = redFirst A⇒A′

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

noNe : ∀ {t A} → ε ⊢ t ∷ A → Neutral t → ⊥
noNe (var x₁ ()) (var x)
noNe (conv ⊢t x) (var n) = noNe ⊢t (var n)
noNe (⊢t ∘ⱼ ⊢t₁) (∘ₙ neT) = noNe ⊢t neT
noNe (conv ⊢t x) (∘ₙ neT) = noNe ⊢t (∘ₙ neT)
noNe (natrecⱼ x ⊢t ⊢t₁ ⊢t₂) (natrecₙ neT) = noNe ⊢t₂ neT
noNe (conv ⊢t x) (natrecₙ neT) = noNe ⊢t (natrecₙ neT)

-- Neutrals do not weak head reduce

neRedTerm : ∀ {Γ t u A} (d : Γ ⊢ t ⇒ u ∷ A) (n : Neutral t) → ⊥
neRedTerm (conv d x) n = neRedTerm d n
neRedTerm (app-subst d x) (∘ₙ n) = neRedTerm d n
neRedTerm (β-red x x₁ x₂) (∘ₙ ())
neRedTerm (natrec-subst x x₁ x₂ d) (natrecₙ n₁) = neRedTerm d n₁
neRedTerm (natrec-zero x x₁ x₂) (natrecₙ ())
neRedTerm (natrec-suc x x₁ x₂ x₃) (natrecₙ ())

neRed : ∀ {Γ A B} (d : Γ ⊢ A ⇒ B) (N : Neutral A) → ⊥
neRed (univ x) N = neRedTerm x N

-- Whnfs do not weak head reduce

whnfRedTerm : ∀ {Γ t u A} (d : Γ ⊢ t ⇒ u ∷ A) (w : Whnf t) → ⊥
whnfRedTerm (conv d x) w = whnfRedTerm d w
whnfRedTerm (app-subst d x) (ne (∘ₙ x₁)) = neRedTerm d x₁
whnfRedTerm (β-red x x₁ x₂) (ne (∘ₙ ()))
whnfRedTerm (natrec-subst x x₁ x₂ d) (ne (natrecₙ x₃)) = neRedTerm d x₃
whnfRedTerm (natrec-zero x x₁ x₂) (ne (natrecₙ ()))
whnfRedTerm (natrec-suc x x₁ x₂ x₃) (ne (natrecₙ ()))

whnfRed : ∀ {Γ A B} (d : Γ ⊢ A ⇒ B) (w : Whnf A) → ⊥
whnfRed (univ x) w = whnfRedTerm x w

whnfRed*Term : ∀ {Γ t u A} (d : Γ ⊢ t ⇒* u ∷ A) (w : Whnf t) → t PE.≡ u
whnfRed*Term (id x) Uₙ = PE.refl
whnfRed*Term (id x) Πₙ = PE.refl
whnfRed*Term (id x) ℕₙ = PE.refl
whnfRed*Term (id x) lamₙ = PE.refl
whnfRed*Term (id x) zeroₙ = PE.refl
whnfRed*Term (id x) sucₙ = PE.refl
whnfRed*Term (id x) (ne x₁) = PE.refl
whnfRed*Term (conv x x₁ ⇨ d) w = ⊥-elim (whnfRedTerm x w)
whnfRed*Term (x ⇨ d) (ne x₁) = ⊥-elim (neRedTerm x x₁)

whnfRed* : ∀ {Γ A B} (d : Γ ⊢ A ⇒* B) (w : Whnf A) → A PE.≡ B
whnfRed* (id x) w = PE.refl
whnfRed* (x ⇨ d) w = ⊥-elim (whnfRed x w)

-- Whr is deterministic

whrDetTerm : ∀{Γ t u A u′ A′} (d : Γ ⊢ t ⇒ u ∷ A) (d′ : Γ ⊢ t ⇒ u′ ∷ A′) → u PE.≡ u′
whrDetTerm (conv d x) d′ = whrDetTerm d d′
whrDetTerm d (conv d′ x₁) = whrDetTerm d d′
whrDetTerm (app-subst d x) (app-subst d′ x₁) rewrite whrDetTerm d d′ = PE.refl
whrDetTerm (app-subst d x) (β-red x₁ x₂ x₃) = ⊥-elim (whnfRedTerm d lamₙ)
whrDetTerm (β-red x x₁ x₂) (app-subst d x₃) = ⊥-elim (whnfRedTerm d lamₙ)
whrDetTerm (β-red x x₁ x₂) (β-red x₃ x₄ x₅) = PE.refl
whrDetTerm (natrec-subst x x₁ x₂ d) (natrec-subst x₃ x₄ x₅ d′) rewrite whrDetTerm d d′ = PE.refl
whrDetTerm (natrec-subst x x₁ x₂ d) (natrec-zero x₃ x₄ x₅) = ⊥-elim (whnfRedTerm d zeroₙ)
whrDetTerm (natrec-subst x x₁ x₂ d) (natrec-suc x₃ x₄ x₅ x₆) = ⊥-elim (whnfRedTerm d sucₙ)
whrDetTerm (natrec-zero x x₁ x₂) (natrec-subst x₃ x₄ x₅ d′) = ⊥-elim (whnfRedTerm d′ zeroₙ)
whrDetTerm (natrec-zero x x₁ x₂) (natrec-zero x₃ x₄ x₅) = PE.refl
whrDetTerm (natrec-suc x x₁ x₂ x₃) (natrec-subst x₄ x₅ x₆ d′) = ⊥-elim (whnfRedTerm d′ sucₙ)
whrDetTerm (natrec-suc x x₁ x₂ x₃) (natrec-suc x₄ x₅ x₆ x₇) = PE.refl

whrDet : ∀{Γ A B B′} (d : Γ ⊢ A ⇒ B) (d′ : Γ ⊢ A ⇒ B′) → B PE.≡ B′
whrDet (univ x) (univ x₁) = whrDetTerm x x₁

whrDet↘Term : ∀{Γ t u A u′} (d : Γ ⊢ t ↘ u ∷ A) (d′ : Γ ⊢ t ⇒* u′ ∷ A) → Γ ⊢ u′ ⇒* u ∷ A
whrDet↘Term (proj₁ , proj₂) (id x) = proj₁
whrDet↘Term (id x , proj₂) (x₁ ⇨ d′) = ⊥-elim (whnfRedTerm x₁ proj₂)
whrDet↘Term (x ⇨ proj₁ , proj₂) (x₁ ⇨ d′) =
  whrDet↘Term (PE.subst (λ x₂ → _ ⊢ x₂ ↘ _ ∷ _) (whrDetTerm x x₁) (proj₁ , proj₂)) d′

whrDet*Term : ∀{Γ t u A u′} (d : Γ ⊢ t ↘ u ∷ A) (d′ : Γ ⊢ t ↘ u′ ∷ A) → u PE.≡ u′
whrDet*Term (id x , proj₂) (id x₁ , proj₄) = PE.refl
whrDet*Term (id x , proj₂) (x₁ ⇨ proj₃ , proj₄) = ⊥-elim (whnfRedTerm x₁ proj₂)
whrDet*Term (x ⇨ proj₁ , proj₂) (id x₁ , proj₄) = ⊥-elim (whnfRedTerm x proj₄)
whrDet*Term (x ⇨ proj₁ , proj₂) (x₁ ⇨ proj₃ , proj₄) =
  whrDet*Term (proj₁ , proj₂) (PE.subst (λ x₂ → _ ⊢ x₂ ↘ _ ∷ _)
                                    (whrDetTerm x₁ x) (proj₃ , proj₄))

whrDet* : ∀{Γ A B B′} (d : Γ ⊢ A ↘ B) (d′ : Γ ⊢ A ↘ B′) → B PE.≡ B′
whrDet* (id x , proj₂) (id x₁ , proj₄) = PE.refl
whrDet* (id x , proj₂) (x₁ ⇨ proj₃ , proj₄) = ⊥-elim (whnfRed x₁ proj₂)
whrDet* (x ⇨ proj₁ , proj₂) (id x₁ , proj₄) = ⊥-elim (whnfRed x proj₄)
whrDet* (A⇒A′ ⇨ A′⇒*B , whnfB) (A⇒A″ ⇨ A″⇒*B′ , whnfB′) =
  whrDet* (A′⇒*B , whnfB) (PE.subst (λ x → _ ⊢ x ↘ _)
                                     (whrDet A⇒A″ A⇒A′)
                                     (A″⇒*B′ , whnfB′))

-- Identity of syntactic reduction

idRed:*: : ∀ {Γ A} → Γ ⊢ A → Γ ⊢ A :⇒*: A
idRed:*: A = [ A , A , id A ]

idRedTerm:*: : ∀ {Γ A t} → Γ ⊢ t ∷ A → Γ ⊢ t :⇒*: t ∷ A
idRedTerm:*: t = [ t , t , id t ]

-- U cannot be a term

UnotInA : ∀ {A Γ} → Γ ⊢ U ∷ A → ⊥
UnotInA (conv U∷U x) = UnotInA U∷U

UnotInA[t] : ∀ {A B t a Γ}
         → t [ a ] PE.≡ U
         → Γ ⊢ a ∷ A
         → Γ ∙ A ⊢ t ∷ B
         → ⊥
UnotInA[t] () x₁ (ℕⱼ x₂)
UnotInA[t] () x₁ (Πⱼ x₂ ▹ x₃)
UnotInA[t] x₁ x₂ (var x₃ here) rewrite x₁ = UnotInA x₂
UnotInA[t] () x₂ (var x₃ (there x₄))
UnotInA[t] () x₁ (lamⱼ x₂ x₃)
UnotInA[t] () x₁ (x₂ ∘ⱼ x₃)
UnotInA[t] () x₁ (zeroⱼ x₂)
UnotInA[t] () x₁ (sucⱼ x₂)
UnotInA[t] () x₁ (natrecⱼ x₂ x₃ x₄ x₅)
UnotInA[t] x x₁ (conv x₂ x₃) = UnotInA[t] x x₁ x₂

redU*Term′ : ∀ {A B U′ Γ} → U′ PE.≡ U → Γ ⊢ A ⇒ U′ ∷ B → ⊥
redU*Term′ U′≡U (conv A⇒U x) = redU*Term′ U′≡U A⇒U
redU*Term′ () (app-subst A⇒U x)
redU*Term′ U′≡U (β-red x x₁ x₂) = UnotInA[t] U′≡U x₂ x₁
redU*Term′ () (natrec-subst x x₁ x₂ A⇒U)
redU*Term′ U′≡U (natrec-zero x x₁ x₂) rewrite U′≡U = UnotInA x₁
redU*Term′ () (natrec-suc x x₁ x₂ x₃)

redU*Term : ∀ {A B Γ} → Γ ⊢ A ⇒* U ∷ B → ⊥
redU*Term (id x) = UnotInA x
redU*Term (x ⇨ A⇒*U) = redU*Term A⇒*U

-- Nothing reduces to U

redU : ∀ {A Γ} → Γ ⊢ A ⇒ U → ⊥
redU (univ x) = redU*Term′ PE.refl x

redU* : ∀ {A Γ} → Γ ⊢ A ⇒* U → A PE.≡ U
redU* (id x) = PE.refl
redU* (x ⇨ A⇒*U) rewrite redU* A⇒*U = ⊥-elim (redU x)


-- Andreas, 2021-04-10, issue #5288
-- De Bruijn index problem in treeless compiler

-- {-# OPTIONS -v tc.cc:20 #-}
-- {-# OPTIONS -v treeless:40 #-}
-- {-# OPTIONS -v treeless.convert.lambdas:40 #-}

open import Agda.Builtin.Equality
open import Agda.Builtin.IO
open import Agda.Builtin.Nat
open import Agda.Builtin.Unit

f : Nat → Nat → Nat
f _ zero = 0
f m      = λ _ → m   -- this catch-all was wrongly compiled

postulate
  printNat : Nat → IO ⊤

{-# COMPILE GHC printNat = print #-}
{-# COMPILE JS  printNat = function (x) { return function(cb) { process.stdout.write(x + "\n"); cb(0); }; } #-}

test : Nat
test = f 123 1

prf : test ≡ 123
prf = refl

main = printNat test

-- Should print 123


open import SOAS.Common
open import SOAS.Families.Core
open import Categories.Object.Initial
open import SOAS.Coalgebraic.Strength
import SOAS.Metatheory.MetaAlgebra

-- Coalgebraic traversal maps
module SOAS.Metatheory.Coalgebraic {T : Set}
  (⅀F : Functor 𝔽amiliesₛ 𝔽amiliesₛ) (⅀:Str : Strength ⅀F)
  (𝔛 : Familyₛ) (open SOAS.Metatheory.MetaAlgebra ⅀F 𝔛)
  (𝕋:Init : Initial 𝕄etaAlgebras)
  where

open import SOAS.Context
open import SOAS.Variable
open import SOAS.Abstract.Hom
import SOAS.Abstract.Coalgebra as →□ ; open →□.Sorted
import SOAS.Abstract.Box as □ ; open □.Sorted

open import SOAS.Coalgebraic.Map

open import SOAS.Metatheory.Algebra {T} ⅀F
open import SOAS.Metatheory.Semantics ⅀F ⅀:Str 𝔛 𝕋:Init
open import SOAS.Metatheory.Traversal ⅀F ⅀:Str 𝔛 𝕋:Init
open import SOAS.Metatheory.Renaming ⅀F ⅀:Str 𝔛 𝕋:Init

open Strength ⅀:Str

-- Relationship of traversal and interpretation, assuming 𝒜 has compatible renaming structure
module _ {𝒜 : Familyₛ}(𝒜ᵇ : Coalg 𝒜)(𝒜ᵃ : MetaAlg 𝒜)
         (open Semantics 𝒜ᵃ)(open Coalg 𝒜ᵇ)
         (rᵃ⇒ : MetaAlg⇒ 𝒜ᵃ (□ᵃ 𝒜ᵃ) r) where

  open MetaAlg 𝒜ᵃ
  open MetaAlg⇒ rᵃ⇒

  𝒜ᴮ : Coalgₚ 𝒜
  𝒜ᴮ = record { ᵇ = 𝒜ᵇ ; η = 𝑣𝑎𝑟 ; r∘η = cong (λ - → - _) ⟨𝑣𝑎𝑟⟩ }

  -- Interpretation and renaming commute
  𝕤𝕖𝕞∘ren : MapEq₁ ℐᴮ 𝑎𝑙𝑔 (λ t ρ → 𝕤𝕖𝕞 (𝕣𝕖𝕟 t ρ))
                          (λ t ρ → r (𝕤𝕖𝕞 t) ρ)
  𝕤𝕖𝕞∘ren = record
    { φ = 𝑣𝑎𝑟
    ; χ = 𝑚𝑣𝑎𝑟
    ; f⟨𝑣⟩ = trans (cong 𝕤𝕖𝕞 Renaming.𝕥⟨𝕧⟩) ⟨𝕧⟩
    ; f⟨𝑚⟩ = trans (cong 𝕤𝕖𝕞 Renaming.𝕥⟨𝕞⟩) ⟨𝕞⟩
    ; f⟨𝑎⟩ = λ{ {σ = σ}{t} → begin
          𝕤𝕖𝕞 (𝕣𝕖𝕟 (𝕒𝕝𝕘 t) σ)
      ≡⟨ cong 𝕤𝕖𝕞 Renaming.𝕥⟨𝕒⟩ ⟩
          𝕤𝕖𝕞 (𝕒𝕝𝕘 (str ℐᴮ 𝕋 (⅀₁ 𝕣𝕖𝕟 t) σ))
      ≡⟨ ⟨𝕒⟩ ⟩
          𝑎𝑙𝑔 (⅀₁ 𝕤𝕖𝕞 (str ℐᴮ 𝕋 (⅀₁ 𝕣𝕖𝕟 t) σ))
      ≡˘⟨ cong 𝑎𝑙𝑔 (str-nat₂ 𝕤𝕖𝕞 (⅀₁ 𝕣𝕖𝕟 t) σ) ⟩
          𝑎𝑙𝑔 (str ℐᴮ 𝒜 (⅀.F₁ (λ { h′ ς → 𝕤𝕖𝕞 (h′ ς) }) (⅀₁ 𝕣𝕖𝕟 t)) σ)
      ≡˘⟨ congr ⅀.homomorphism (λ - → 𝑎𝑙𝑔 (str ℐᴮ 𝒜 - σ)) ⟩
          𝑎𝑙𝑔 (str ℐᴮ 𝒜 (⅀₁ (λ{ t ρ → 𝕤𝕖𝕞 (𝕣𝕖𝕟 t ρ)}) t) σ)
      ∎ }
    ; g⟨𝑣⟩ = trans (r≈₁ ⟨𝕧⟩) (cong (λ - → - _) ⟨𝑣𝑎𝑟⟩)
    ; g⟨𝑚⟩ = trans (r≈₁ ⟨𝕞⟩) (cong (λ - → - _) ⟨𝑚𝑣𝑎𝑟⟩)
    ; g⟨𝑎⟩ = λ{ {σ = σ}{t} → begin
          r (𝕤𝕖𝕞 (𝕒𝕝𝕘 t)) σ
      ≡⟨ r≈₁ ⟨𝕒⟩ ⟩
          r (𝑎𝑙𝑔 (⅀₁ 𝕤𝕖𝕞 t)) σ
      ≡⟨ cong (λ - → - σ) ⟨𝑎𝑙𝑔⟩ ⟩
          𝑎𝑙𝑔 (str ℐᴮ 𝒜 (⅀₁ r (⅀₁ 𝕤𝕖𝕞 t)) σ)
      ≡˘⟨ congr ⅀.homomorphism (λ - → 𝑎𝑙𝑔 (str ℐᴮ 𝒜 - σ)) ⟩
          𝑎𝑙𝑔 (str ℐᴮ 𝒜 (⅀₁ (λ{ t ρ → r (𝕤𝕖𝕞 t) ρ}) t) σ)
      ∎ }
    } where open ≡-Reasoning

  -- Interpretation is a pointed □-coalgebra homomorphism
  𝕤𝕖𝕞ᵇ⇒ : Coalg⇒ 𝕋ᵇ 𝒜ᵇ 𝕤𝕖𝕞
  𝕤𝕖𝕞ᵇ⇒ = record { ⟨r⟩ = λ{ {t = t} → MapEq₁.≈ 𝕤𝕖𝕞∘ren t } }

  𝕤𝕖𝕞ᴮ⇒ : Coalgₚ⇒ 𝕋ᴮ 𝒜ᴮ 𝕤𝕖𝕞
  𝕤𝕖𝕞ᴮ⇒ = record { ᵇ⇒ = 𝕤𝕖𝕞ᵇ⇒ ; ⟨η⟩ = ⟨𝕧⟩ }

-- Coalgebraic traversal maps
module Travᶜ {𝒫 𝒜 : Familyₛ}(𝒫ᴮ : Coalgₚ 𝒫)(𝑎𝑙𝑔 : ⅀ 𝒜 ⇾̣ 𝒜)
               (φ : 𝒫 ⇾̣ 𝒜)(χ : 𝔛 ⇾̣ 〖 𝒜 , 𝒜 〗) where
  open Coalgₚ 𝒫ᴮ

  open Traversal 𝒫ᴮ 𝑎𝑙𝑔 φ χ

  -- Traversal is derived from 𝕤𝕖𝕞, so it is also a pointed coalgebra homomorphism
  𝕥𝕣𝕒𝕧ᵇ⇒ : Coalg⇒ 𝕋ᵇ Travᵇ 𝕥𝕣𝕒𝕧
  𝕥𝕣𝕒𝕧ᵇ⇒ = 𝕤𝕖𝕞ᵇ⇒ Travᵇ Travᵃ record
    { ⟨𝑎𝑙𝑔⟩ = λ{ {t = t} → dext² (λ ρ ς → cong 𝑎𝑙𝑔 (str-dist 𝒜 (jᶜ 𝒫ᴮ) t ρ ς)) }
    ; ⟨𝑣𝑎𝑟⟩ = refl ; ⟨𝑚𝑣𝑎𝑟⟩ = refl }

  𝕥𝕣𝕒𝕧ᴮ⇒ : Coalgₚ⇒ 𝕋ᴮ Travᴮ 𝕥𝕣𝕒𝕧
  𝕥𝕣𝕒𝕧ᴮ⇒  = record { ᵇ⇒ = 𝕥𝕣𝕒𝕧ᵇ⇒ ; ⟨η⟩ = ⟨𝕧⟩ }

  -- Assuming 𝒜 is also a pointed □-coalgebra, traversal also commutes with renaming
  module _ (𝒜ᴮ : Coalgₚ 𝒜)(φᴮ : Coalgₚ⇒ 𝒫ᴮ 𝒜ᴮ φ)
           (𝒜rᵃ : MetaAlg⇒ 𝒜ᵃ (□ᵃ 𝒜ᵃ) (Coalgₚ.r 𝒜ᴮ)) where

    private module 𝒜ᴮ = Coalgₚ 𝒜ᴮ
    private module φᴮ = Coalgₚ⇒ φᴮ
    private module 𝒜rᵃ = MetaAlg⇒ 𝒜rᵃ

    -- Renaming and interpretation can commute
    r∘𝕥𝕣𝕒𝕧 : MapEq₂ 𝒫ᴮ ℐᴮ 𝑎𝑙𝑔 (λ t σ ϱ → 𝒜ᴮ.r (𝕥𝕣𝕒𝕧 t σ) ϱ)
                              (λ t σ ϱ → 𝕥𝕣𝕒𝕧 t (λ v → r (σ v) ϱ))
    r∘𝕥𝕣𝕒𝕧 = record
      { φ = 𝒜ᴮ.η
      ; ϕ = λ v → 𝒜ᴮ.r (φ v)
      ; χ = χ
      ; f⟨𝑣⟩ = 𝒜ᴮ.r≈₁ 𝕥⟨𝕧⟩
      ; f⟨𝑚⟩ = trans (𝒜ᴮ.r≈₁ 𝕥⟨𝕞⟩) (cong (λ - → - _) 𝒜rᵃ.⟨𝑚𝑣𝑎𝑟⟩)
      ; f⟨𝑎⟩ = λ{ {σ = σ}{ϱ}{t} → begin
            𝒜ᴮ.r (𝕥𝕣𝕒𝕧 (𝕒𝕝𝕘 t) σ) ϱ
        ≡⟨ 𝒜ᴮ.r≈₁ 𝕥⟨𝕒⟩ ⟩
            𝒜ᴮ.r (𝑎𝑙𝑔 (str 𝒫ᴮ 𝒜 (⅀₁ 𝕥𝕣𝕒𝕧 t) σ)) ϱ
        ≡⟨ cong (λ - → - ϱ) 𝒜rᵃ.⟨𝑎𝑙𝑔⟩ ⟩
            𝑎𝑙𝑔 (str ℐᴮ 𝒜 (⅀.F₁ 𝒜ᴮ.r (str 𝒫ᴮ 𝒜 (⅀.F₁ 𝕥𝕣𝕒𝕧 t) σ)) ϱ)
        ≡˘⟨ congr (str-nat₂ 𝒜ᴮ.r (⅀.F₁ 𝕥𝕣𝕒𝕧 t) σ) (λ - → 𝑎𝑙𝑔 (str ℐᴮ 𝒜 - ϱ)) ⟩
            𝑎𝑙𝑔 (str ℐᴮ 𝒜 (str 𝒫ᴮ (□ 𝒜) (⅀.F₁ (λ { h ς → 𝒜ᴮ.r (h ς) }) (⅀.F₁ 𝕥𝕣𝕒𝕧 t)) σ) ϱ)
        ≡˘⟨ congr ⅀.homomorphism (λ - → 𝑎𝑙𝑔 (str ℐᴮ 𝒜 (str 𝒫ᴮ (□ 𝒜) - σ)  ϱ)) ⟩
            𝑎𝑙𝑔 (str ℐᴮ 𝒜 (str 𝒫ᴮ (□ 𝒜) (⅀₁ (λ{ t σ → 𝒜ᴮ.r (𝕥𝕣𝕒𝕧 t σ)}) t) σ)  ϱ)
        ∎ }
      ; g⟨𝑣⟩ = trans 𝕥⟨𝕧⟩ φᴮ.⟨r⟩
      ; g⟨𝑚⟩ = 𝕥⟨𝕞⟩
      ; g⟨𝑎⟩ = λ{ {σ = σ}{ϱ}{t} → begin
            𝕥𝕣𝕒𝕧 (𝕒𝕝𝕘 t) (λ x → r (σ x) ϱ)
        ≡⟨ 𝕥⟨𝕒⟩ ⟩
            𝑎𝑙𝑔 (str 𝒫ᴮ 𝒜 (⅀₁ 𝕥𝕣𝕒𝕧 t) (λ x → r (σ x) ϱ))
        ≡⟨ cong 𝑎𝑙𝑔 (str-dist 𝒜 (rᶜ 𝒫ᴮ) (⅀₁ 𝕥𝕣𝕒𝕧 t) σ ϱ) ⟩
            𝑎𝑙𝑔 (str ℐᴮ 𝒜 (str 𝒫ᴮ (□ 𝒜) (⅀.F₁ (precomp 𝒜 r) (⅀₁ 𝕥𝕣𝕒𝕧 t)) σ) ϱ)
        ≡˘⟨ congr ⅀.homomorphism (λ - → 𝑎𝑙𝑔 (str ℐᴮ 𝒜 (str 𝒫ᴮ (□ 𝒜) - σ) ϱ)) ⟩
            𝑎𝑙𝑔 (str ℐᴮ 𝒜  (str 𝒫ᴮ (□ 𝒜) (⅀₁ (λ{ t σ ϱ → 𝕥𝕣𝕒𝕧 t (λ v → r (σ v) ϱ)}) t) σ) ϱ)
        ∎ }
      } where open ≡-Reasoning

    -- The traversal map 𝕋 ⇾ 〖𝒫, 𝒜〗 is pointed coalgebraic if 𝒜 has coalgebra structure
    𝕥𝕣𝕒𝕧ᶜ : Coalgebraic 𝕋ᴮ 𝒫ᴮ 𝒜ᴮ 𝕥𝕣𝕒𝕧
    𝕥𝕣𝕒𝕧ᶜ = record { r∘f = λ{ {σ = σ}{ϱ}{t = t} → MapEq₂.≈ r∘𝕥𝕣𝕒𝕧 t }
                  ; f∘r = λ{ {ρ = ρ}{ς}{t = t} → cong (λ - → - ς) (Coalg⇒.⟨r⟩ 𝕥𝕣𝕒𝕧ᵇ⇒ {ρ = ρ}{t = t}) }
                  ; f∘η = trans 𝕥⟨𝕧⟩ φᴮ.⟨η⟩ }


postulate
  A : Set

variable
  {xx} : A

record R : Set₁ where
  field
    P : A → Set
    a : P xx
    b : P xx
    c : P xx
    d : P xx
    e : P xx
    f : P xx
    g : P xx
    h : P xx
    i : P xx
    j : P xx
    k : P xx
    l : P xx
    m : P xx
    n : P xx
    o : P xx
    p : P xx
    q : P xx
    r : P xx
    s : P xx
    t : P xx
    u : P xx
    v : P xx
    w : P xx
    x : P xx
    y : P xx
    z : P xx


open import OutsideIn.Prelude
open import OutsideIn.X
module OutsideIn.TopLevel(x : X) where
  import OutsideIn.Expressions as E
  open E(x)
  open X(x)

  data Program (ev : Set)(tv : Set) : Set where
    end : Program ev tv
    bind₁_,_ : ∀ {s} → Expression ev tv s → Program (Ⓢ ev) tv → Program ev tv
    bind₂_·_∷_⇒_,_ : ∀ {s} → (n : ℕ) → Expression ev (tv ⨁ n) s
                   → QConstraint (tv ⨁ n) → Type (tv ⨁ n)
                   → Program (Ⓢ ev) tv → Program ev tv


variable
  X : Set

postulate
  foo : ∀ A -> X   -- error at `src/full/Agda/TypeChecking/Monad/MetaVars.hs:98`
                   -- expected: `{X : Set} -> _1 -> X`
  Y : Set
  bar : ∀ A -> Y   -- normal `_1 -> Y` type with unsolved metavar


-- 2014-05-27 Jesper and Andreas

postulate
  A : Set
  R : A → A → Set

{-# BUILTIN REWRITE R #-}
{-# REWRITE R #-}

-- Expected error:
-- R  does not target rewrite relation
-- when checking the pragma REWRITE R


open import Prelude

open import Level using (_⊔_; Lift; lift) renaming (suc to ls; zero to lz)
open import Data.String using (String)
open import Data.Maybe using (Maybe; nothing; just)
open import Data.Nat using (_≤_)

module RW.Data.RTrie.Insert
    where

  open import Relation.Binary.PropositionalEquality
    using (inspect; [_])

  open import RW.Data.RTrie.Decl
  import RW.Data.PMap (RTermᵢ ⊥) as IdxMap
  import RW.Data.PMap ℕ as ℕmap

  postulate
    trie-err : ∀{a}{A : Set a} → String → A

  open import RW.Utils.Monads
  open Monad {{...}}
  open Eq {{...}}

  I : ∀{a} → Set a → Set a
  I {a} = STₐ {lz} {a} (Σ ℕ (λ _ → Maybe ℕ))

  _<$>_ : ∀{a}{A B : Set a} → (A → B) → I A → I B
  f <$> ix = ix >>= (return ∘ f)

  --------------------
  -- Monadic boilerplate
  private
    getLbl : I (Maybe ℕ)
    getLbl = getₐ >>= return ∘ p2

    putLbl : ℕ → I Unit
    putLbl n = getₐ >>= λ x → putₐ (p1 x , just n)

    getCount : I ℕ
    getCount = p1 <$> getₐ

    putCount : ℕ → I Unit
    putCount x = getLbl >>= putₐ ∘ (_,_ x)

    ++count : I ℕ
    ++count = getCount <>= (putCount ∘ suc)

    CellCtx : Set _
    CellCtx = RTrie → Cell

    singleton : ∀{a}{A : Set a} → A → List A
    singleton x = x ∷ []

  applyBRule : Rule → ℕ → Maybe ℕ
  applyBRule (Tr m n) k with m ≟-ℕ k
  ...| yes _ = just n
  ...| no  _ = nothing
  applyBRule _ _ = nothing

  -- |Makes a new rule *without* checking anything.
  --  If the current label is nothing, returns a Gather
  --  If the current label is a (just l), return a Tr l.
  --
  --  Changes the state to the newly created label.
  makeRule : I Rule
  makeRule = getLbl
         >>= λ l → (++count <>= putLbl) -- increments the counter and set's it.
         >>= λ c′ → return $ maybe (flip Tr c′) (Gr c′) l

  -- |Given a list of rules, which arise from we reaching
  --  either a leaf node or a previously bound symbol,
  --  will apply one of such rules or create a new one.
  --
  --  In any case, this will change the current label either
  --  to a fresh one or by a transition in the list.
  handleRules : List Rule → I (List Rule)
  handleRules rs = getLbl >>= maybe (flip l≡just rs) (l≡nothing rs)
    where
      l≡just : ℕ → List Rule → I (List Rule)
      l≡just l [] = singleton <$> makeRule
      l≡just l (r ∷ rs) with applyBRule r l
      ...| just l′ = putLbl l′ >> return (r ∷ rs)
      ...| nothing = (_∷_ r) <$> l≡just l rs

      l≡nothing : List Rule → I (List Rule)
      l≡nothing [] = singleton <$> makeRule
      l≡nothing ((Gr k) ∷ rs) = putLbl k >> return ((Gr k) ∷ rs)
      l≡nothing (r ∷ rs)      = _∷_ r <$> l≡nothing rs

  -- |Given a cell and a NON-BINDING index, mIdx takes care
  --  of finding the trie we need to keep traversing and
  --  creating a reconstruction function, for when we
  --  finish modifying the mentioned trie.
  mIdx : Cell → RTermᵢ ⊥
       → I (CellCtx × RTrie)
  -- In the case we are inserting a ivarᵢ, we are going to merge the new btrie,
  -- which is going to be a leaf (TODO: why?), in the default branch.
  mIdx ((d , mh) , bs) (ivarᵢ _)
    = return $ (λ bt → (merge d bt , mh) , bs) , BTrieEmpty
    where
      merge : RTrie → RTrie → RTrie
      merge (Leaf as) (Leaf bs) = Leaf (as ++ bs)
      merge _ bt                = bt
  -- For the more general case, if tid ∉ mh, we add and entry (tid ↦ empty).
  -- After, we return mh(tid) and the context that modifies this exact entry.
  mIdx ((d , mh) , bs) tid
    = let mh′ , prf = IdxMap.alterPrf BTrieEmpty tid mh
    in return $ (λ f → (d , IdxMap.insert tid f mh) , bs)
              , (IdxMap.lkup' tid mh′ prf)

  -- |When we find a binding symbol, however, things can be a bit more tricky.
  --  This symbol is either registered, in which case we just add a fresh
  --  rule to it, or it is not registered in the map, where we add it with
  --  a fresh rule.
  mSym : Cell → ℕ
       → I (CellCtx × RTrie)
  mSym (mh , bs) tsym with ℕmap.lkup tsym bs
  ...| nothing = makeRule
             >>= λ r → return (const (mh , (tsym , r ∷ []) ∷ bs)
                              , BTrieEmpty)
  ...| just rs = handleRules rs
             >>= λ r → return (const (mh , ℕmap.insert tsym r bs)
                              , BTrieEmpty)

  -- |𝑴 chooses which traversal function to use.
  𝑴 : {A : Set}{{enA : Enum A}}
     → Cell → RTermᵢ A → I (CellCtx × RTrie)
  𝑴 {{enum aℕ _}} c tid with toSymbol tid | inspect toSymbol tid
  ...| nothing | [ prf ] = mIdx c (idx-cast tid prf)
  ...| just s  | _       = maybe (mSym c) enum-err (aℕ s)
    where postulate enum-err : I (CellCtx × RTrie)

  -- |Insertion of an (opened) term in a cell. Returns the altered cell.
  mutual
    insCell* : {A : Set}{{enA : Enum A}}
             → List (RTerm A) → List Cell → I (List Cell)
    insCell* [] _ = return []
    insCell* _ [] = return []
    insCell* (t ∷ ts) (b ∷ bs)
      = insCell (out t) b >>= λ b′ → (_∷_ b′) <$> insCell* ts bs

    -- Variation of insCell*, assuming we're always adding to empty cells.
    insCell*ε : {A : Set}{{enA : Enum A}} → List (RTerm A) → I (List Cell)
    insCell*ε [] = return []
    insCell*ε (t ∷ ts)
      = insCell (out t) ((Leaf [] , IdxMap.empty) , [])
      >>= λ b → (_∷_ b) <$> insCell*ε ts

    {-# TERMINATING #-}
    insCell : {A : Set}{{enA : Enum A}}
            → RTermᵢ A × List (RTerm A) → Cell → I Cell
    insCell (tid , tr) cell
      = 𝑴 cell tid
      >>= λ { (c , bt) → insCellAux tid tr bt >>= return ∘ c }
      where
        -- Note how if tid is a binding symbol, we don't do anything. That's
        -- because 𝑴 already took care of adding the rules in the correct place for us.
        tr≡[] : {A : Set}{{enA : Enum A}}
              → RTermᵢ A → I RTrie
        tr≡[] tid with toSymbol tid
        ...| nothing = (Leaf ∘ singleton) <$> makeRule
        ...| _       = return $ Fork []

        insCellAux : {A : Set}{{enA : Enum A}}
                   → RTermᵢ A → List (RTerm A) → RTrie
                   → I RTrie
        -- Inserting in a Leaf is impossible...
        insCellAux tid _  (Leaf r) = return (Leaf r)
        -- If we don't have recursive arguments in the term beeing inserted,
        -- we follow by tr≡[]
        insCellAux tid [] _        = tr≡[] tid
        -- Otherwise we simply add our recursive arguments.
        insCellAux tid tr (Fork [])
          = Fork <$> insCell*ε tr
        insCellAux tid tr (Fork ms)
          = Fork <$> insCell* tr ms

  -- |Insertion has to begin in a 1-cell fork.
  --  This gives some intuition that BTries should contain an arity, somewhere in their type.
  ins : {A : Set}{{enA : Enum A}} → RTerm A → RTrie → I RTrie
  ins t (Fork (cell ∷ []))
    = (Fork ∘ singleton) <$> insCell (out t) cell
  ins t (Fork [])
    = (Fork ∘ singleton) <$> insCell (out t) ((Leaf [] , IdxMap.empty) , [])
  ins t _ = trie-err "Insertion has to begin in a 1-cell fork"

  -- Interfacing
  {-# TERMINATING #-}
  insertTerm : {A : Set}{{enA : Enum A}} → Name → RTerm A → (ℕ × RTrie) → (ℕ × RTrie)
  insertTerm d term (n , Leaf r) = trie-err "Can't insert in a leaf"
  insertTerm d term (n , bt)
    = let bt′ , n′ , lbl = STₐ.run (ins term bt) (n + 1 , nothing)
      in maybe′ (λ l′ → l′ , substΣ l′ d bt′)
                (trie-err "empty final lbl")  lbl
    where
      open import Data.Maybe using (maybe′)

      -- Substitution boilerplate.

      sR : ℕ → Name → Rule → Rule
      sR k c (Tr m n) with n ≟-ℕ k
      ...| yes _ = Fr m c
      ...| no  _ = Tr m n
      sR _ _ r = r

      mutual
        sC : ℕ → Name → Cell → Cell
        sC k c ((d , mh) , bs)
          = (substΣ k c d
            , IdxMap.map (substΣ k c) mh)
          , ℕmap.map (Prelude.map (sR k c)) bs

        substΣ : ℕ → Name → RTrie → RTrie
        substΣ k c (Leaf rs) = Leaf (Prelude.map (sR k c) rs)
        substΣ k c (Fork ms) = Fork (Prelude.map (sC k c) ms)