module JVM.Defaults.Syntax.Instructions.Show where

open import Data.String as String hiding (show)
open import Data.Nat.Show as Nat hiding (show)
open import Relation.Binary.PropositionalEquality
open import Relation.Ternary.Structures.Syntax
open import Relation.Ternary.Monad.Weakening
open import Relation.Ternary.Data.ReflexiveTransitive

open import JVM.Types
open import JVM.Contexts
open import JVM.Defaults.Syntax.Values
open import JVM.Defaults.Syntax.Instructions
open import JVM.Model using (↑; ↓)

show-instr : ∀ {Φ} → ⟨ Γ ∣ ψ₁ ⇒ ψ₂ ⟩ Φ → String
show-instr noop      = "noop"
show-instr pop       = "pop"
show-instr (push x)  = "push"
  where
    show-const : Const a → String
    show-const null    = "null"
    show-const unit    = "unit"
    show-const (num x) = Nat.show x
show-instr dup       = "dup"
show-instr swap      = "swap"
show-instr (bop x)   = "bop"
show-instr new       = "new"
show-instr read      = "read"
show-instr write     = "write"
show-instr (load (refl ⇈ wk))  = "load "  ++ Nat.show (indexOf wk)
show-instr (store (refl ⇈ wk)) = "store " ++ Nat.show (indexOf wk)
show-instr (goto x)  = "goto"
show-instr (if c x₁) = "if" ++ show-comp c
  where
    show-comp : Comparator → String
    show-comp eq = "eq"
    show-comp ne = "ne"
    show-comp lt = "lt"
    show-comp ge = "ge"
    show-comp gt = "gt"
    show-comp le = "le"
show-instr ret       = "ret"

show-code : ∀ {Γ Φ} → Code Γ ψ₁ ψ₂ Φ → String
show-code (labeled (_ ∙⟨ _ ⟩ ↓ i))   = "<>: " ++ show-instr i
show-code (instr (↓ i))              = "    " ++ show-instr i

show : ∀ {Φ} → ⟪ Γ ∣ ψ₁ ⇒ ψ₂ ⟫ Φ → String
show nil      = ""
show (c ▹⟨ σ ⟩ is) = show-code c ++ "\n" ++ show is


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

open import HoTT
open import homotopy.PtdAdjoint
open import groups.FromSusp
open import groups.ToOmega

module groups.SuspAdjointLoop {i} where

  import homotopy.SuspAdjointLoop {i} as A

  module _ (X Y : Ptd i) where

    private
      pres-comp : preserves-comp
        (GroupStructure.comp (⊙→Ω-group-structure (⊙Susp X) Y))
        (GroupStructure.comp (⊙→Ω-group-structure X (⊙Ω Y)))
        (–> (A.eq X (⊙Ω Y)))
    abstract
      pres-comp h₁ h₂ =
        B.nat-cod h₁ h₂ ⊙Ω-∙
        ∙ ap (_⊙∘ ⊙fanout (–> (A.eq X (⊙Ω Y)) h₁) (–> (A.eq X (⊙Ω Y)) h₂))
             arr2-lemma
        where
        module A× = RightAdjoint× A.hadj
        module B = RightAdjointBinary A.hadj

        ap2-lemma : ∀ {i j k} {A : Type i} {B : Type j} {C : Type k}
          (f : A × B → C) {r s : A × B} (p : r == s)
          → ap f p == ap2 (curry f) (ap fst p) (ap snd p)
        ap2-lemma f idp = idp

        ⊙ap2-lemma : ∀ {i j k} {X : Ptd i} {Y : Ptd j} {Z : Ptd k}
          (f : X ⊙× Y ⊙→ Z)
          → ⊙Ω-fmap f == ⊙Ω-fmap2 f ⊙∘ ⊙fanout (⊙Ω-fmap ⊙fst) (⊙Ω-fmap ⊙snd)
        ⊙ap2-lemma (f , idp) = ⊙λ=' (ap2-lemma f) idp

        arr2-lemma : B.arr2 ⊙Ω-∙ == ⊙Ω-∙
        arr2-lemma =
          ⊙Ω-fmap ⊙Ω-∙ ⊙∘ A×.⊙out _ _
            =⟨ ⊙ap2-lemma ⊙Ω-∙ |in-ctx _⊙∘ A×.⊙out _ _ ⟩
          (⊙Ω-fmap2 ⊙Ω-∙ ⊙∘ A×.⊙into _ _) ⊙∘ A×.⊙out _ _
            =⟨ ⊙λ= $ ⊙∘-assoc (⊙Ω-fmap2 ⊙Ω-∙) (A×.⊙into _ _) (A×.⊙out _ _) ⟩
          ⊙Ω-fmap2 ⊙Ω-∙ ⊙∘ (A×.⊙into _ _ ⊙∘ A×.⊙out _ _)
            =⟨ A×.⊙into-out _ _ |in-ctx ⊙Ω-fmap2 ⊙Ω-∙ ⊙∘_ ⟩
          ⊙Ω-fmap2 ⊙Ω-∙
            =⟨ ⊙Ω-fmap2-∙ ⟩
          ⊙Ω-∙ ∎

    ⊙→Ω-iso-⊙→Ω : ⊙→Ω-group-structure (⊙Susp X) Y ≃ᴳˢ ⊙→Ω-group-structure X (⊙Ω Y)
    ⊙→Ω-iso-⊙→Ω = ≃-to-≃ᴳˢ (A.eq X (⊙Ω Y)) pres-comp

    Trunc-⊙→Ω-iso-Trunc-⊙→Ω : Trunc-⊙→Ω-group (⊙Susp X) Y ≃ᴳ Trunc-⊙→Ω-group X (⊙Ω Y)
    Trunc-⊙→Ω-iso-Trunc-⊙→Ω = Trunc-group-emap ⊙→Ω-iso-⊙→Ω

  abstract
    Trunc-⊙→Ω-iso-Trunc-⊙→Ω-nat-dom : {X Y : Ptd i} (f : X ⊙→ Y) (Z : Ptd i)
      → fst (Trunc-⊙→Ω-iso-Trunc-⊙→Ω X Z) ∘ᴳ Trunc-⊙→Ω-group-fmap-dom (⊙Susp-fmap f) Z
        == Trunc-⊙→Ω-group-fmap-dom f (⊙Ω Z) ∘ᴳ fst (Trunc-⊙→Ω-iso-Trunc-⊙→Ω Y Z)
    Trunc-⊙→Ω-iso-Trunc-⊙→Ω-nat-dom f Z = group-hom= $ λ= $ Trunc-elim
      (λ g → ap [_] (! (A.nat-dom f (⊙Ω Z) g)))

  module _ (X Y : Ptd i) where

    private
      pres-comp'' : ∀ h₀ h₁ →
          fst (<– (A.eq X Y) (GroupStructure.comp (⊙→Ω-group-structure X Y) (–> (A.eq X Y) h₀) (–> (A.eq X Y) h₁)))
        ∼ fst (GroupStructure.comp (Susp⊙→-group-structure X Y) h₀ h₁)
    abstract
      pres-comp'' (h₀ , idp) (h₁ , h₁-pt) =
        Susp-elim
          idp
          (! h₁-pt ∙ ap h₁ (merid (pt X)))
          (λ x → ↓-='-in' $
            ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt)) ∘ pinch X) (merid x)
              =⟨ ap-∘ (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) (pinch X) (merid x)  ⟩
            ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) (ap (pinch X) (merid x))
              =⟨ ap (ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt)))) (Pinch.merid-β X x) ⟩
            ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) (ap winl (σloop X x) ∙ wglue ∙ ap winr (merid x))
              =⟨ ap-∙∙ (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) (ap winl (σloop X x)) wglue (ap winr (merid x)) ⟩
            ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) (ap winl (σloop X x))
            ∙ ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) wglue
            ∙ ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) (ap winr (merid x))
              =⟨ ap3 (λ p q r → p ∙ q ∙ r)
                   (∘-ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) winl (σloop X x))
                   (⊙WedgeRec.glue-β (h₀ , idp) (h₁ , h₁-pt))
                   (∘-ap (fst (⊙Wedge-rec (h₀ , idp) (h₁ , h₁-pt))) winr (merid x)) ⟩
            ap h₀ (σloop X x) ∙ ! h₁-pt ∙ ap h₁ (merid x)
              =⟨ lemma h₁ (ap h₀ (σloop X x)) h₁-pt (merid x) (merid (pt X)) h₁-pt ⟩
            (ap h₀ (σloop X x) ∙ (! h₁-pt ∙ ap h₁ (σloop X x) ∙' h₁-pt)) ∙' (! h₁-pt ∙ ap h₁ (merid (pt X)))
              =⟨ ap (λ p → p ∙' (! h₁-pt ∙ ap h₁ (merid (pt X)))) $
                  ap h₀ (σloop X x) ∙ (! h₁-pt ∙ ap h₁ (σloop X x) ∙' h₁-pt)
                    =⟨ ! $ ap (ap h₀ (σloop X x) ∙_) (Ω-fmap-β (h₁ , h₁-pt) (σloop X x)) ⟩
                  ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x)
                    =⟨ ! $ A.Eta.merid-β Y (ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x)) ⟩
                  ap (fst (A.ε Y)) (merid (ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x)))
                    =⟨ ! $ ap (ap (fst (A.ε Y))) (SuspFmap.merid-β (λ x → ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x)) x) ⟩
                  ap (fst (A.ε Y)) (ap (Susp-fmap (λ x → ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x))) (merid x))
                    =⟨ ∘-ap (fst (A.ε Y)) (Susp-fmap (λ x → ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x))) (merid x) ⟩
                  ap (fst (A.ε Y) ∘ Susp-fmap (λ x → ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x))) (merid x)
                    =∎ ⟩
            ap (fst (A.ε Y) ∘ Susp-fmap (λ x → ap h₀ (σloop X x) ∙ Ω-fmap (h₁ , h₁-pt) (σloop X x))) (merid x)
            ∙' (! h₁-pt ∙ ap h₁ (merid (pt X)))
              =∎)
        where
        lemma : ∀ {i j} {A : Type i} {B : Type j} (f : A → B)
          {a₀ a₁ a₂ : A} {b₀ b₁ b₂ : B} (p₀ : b₀ == b₁) (p₁ : f a₀ == b₁)
          (p₂ : a₀ == a₁) (p₃ : a₂ == a₁) (p₄ : f a₂ == b₂)
          → p₀ ∙ ! p₁ ∙ ap f p₂ == (p₀ ∙ (! p₁ ∙ ap f (p₂ ∙ ! p₃) ∙' p₄)) ∙' (! p₄ ∙ ap f p₃)
        lemma f idp idp idp idp idp = idp

      private
        pres-comp' : ∀ h₀ h₁ →
             <– (A.eq X Y) (GroupStructure.comp (⊙→Ω-group-structure X Y) (–> (A.eq X Y) h₀) (–> (A.eq X Y) h₁))
          ⊙∼ GroupStructure.comp (Susp⊙→-group-structure X Y) h₀ h₁
      abstract
        pres-comp' (h₀ , idp) (h₁ , h₁-pt) =
          pres-comp'' (h₀ , idp) (h₁ , h₁-pt) , idp

      private
        pres-comp : preserves-comp
          (GroupStructure.comp (Susp⊙→-group-structure X Y))
          (GroupStructure.comp (⊙→Ω-group-structure X Y))
          (–> (A.eq X Y))
      abstract
        pres-comp h₀ h₁ =
          –> (A.eq X Y) (GroupStructure.comp (Susp⊙→-group-structure X Y) h₀ h₁)
            =⟨ ! (ap (–> (A.eq X Y)) (⊙λ= (pres-comp' h₀ h₁))) ⟩
          –> (A.eq X Y) (<– (A.eq X Y) (GroupStructure.comp (⊙→Ω-group-structure X Y) (–> (A.eq X Y) h₀) (–> (A.eq X Y) h₁)))
            =⟨ <–-inv-r (A.eq X Y) (GroupStructure.comp (⊙→Ω-group-structure X Y) (–> (A.eq X Y) h₀) (–> (A.eq X Y) h₁)) ⟩
          GroupStructure.comp (⊙→Ω-group-structure X Y) (–> (A.eq X Y) h₀) (–> (A.eq X Y) h₁)
            =∎

    Susp⊙→-iso-⊙→Ω : Susp⊙→-group-structure X Y ≃ᴳˢ ⊙→Ω-group-structure X Y
    Susp⊙→-iso-⊙→Ω = ≃-to-≃ᴳˢ (A.eq X Y) pres-comp

    Trunc-Susp⊙→-iso-Trunc-⊙→Ω : Trunc-Susp⊙→-group X Y ≃ᴳ Trunc-⊙→Ω-group X Y
    Trunc-Susp⊙→-iso-Trunc-⊙→Ω = Trunc-group-emap Susp⊙→-iso-⊙→Ω

  module _ (X Y : Ptd i) where

    private
      pres-comp : preserves-comp
        (GroupStructure.comp (Susp⊙→-group-structure X Y))
        (GroupStructure.comp (Susp⊙→-group-structure (⊙Susp X) (⊙Susp Y)))
        (⊙Susp-fmap :> ((⊙Susp X ⊙→ Y) → _))
    abstract
      pres-comp = ∼-preserves-preserves-comp
        (GroupStructure.comp (Susp⊙→-group-structure X Y))
        (GroupStructure.comp (Susp⊙→-group-structure (⊙Susp X) (⊙Susp Y)))
        (λ f →
          <– (A.eq (⊙Susp X) (⊙Susp Y)) (<– (A.eq X (⊙Ω (⊙Susp Y))) (⊙Ω-fmap (A.η Y) ⊙∘ –> (A.eq X Y) f))
            =⟨ ap (<– (A.eq (⊙Susp X) (⊙Susp Y)) ∘ <– (A.eq X (⊙Ω (⊙Susp Y)))) $ A.nat-cod X (A.η Y) f ⟩
          <– (A.eq (⊙Susp X) (⊙Susp Y)) (<– (A.eq X (⊙Ω (⊙Susp Y))) (–> (A.eq X (⊙Ω (⊙Susp Y))) (A.η Y ⊙∘ f)))
            =⟨ ap (<– (A.eq (⊙Susp X) (⊙Susp Y))) $ <–-inv-l (A.eq X (⊙Ω (⊙Susp Y))) (A.η Y ⊙∘ f)  ⟩
          <– (A.eq (⊙Susp X) (⊙Susp Y)) (A.η Y ⊙∘ f)
            =⟨ ap (<– (A.eq (⊙Susp X) (⊙Susp Y))) $ A.η-natural f ⟩
          <– (A.eq (⊙Susp X) (⊙Susp Y)) (–> (A.eq (⊙Susp X) (⊙Susp Y)) (⊙Susp-fmap f))
            =⟨ <–-inv-l (A.eq (⊙Susp X) (⊙Susp Y)) (⊙Susp-fmap f) ⟩
          ⊙Susp-fmap f
            =∎)
        (GroupStructureHom.pres-comp $
              GroupStructureIso.g-shom (Susp⊙→-iso-⊙→Ω (⊙Susp X) (⊙Susp Y))
          ∘ᴳˢ GroupStructureIso.g-shom (⊙→Ω-iso-⊙→Ω X (⊙Susp Y))
          ∘ᴳˢ ⊙→Ω-group-structure-fmap-codom X (A.η Y)
          ∘ᴳˢ GroupStructureIso.f-shom (Susp⊙→-iso-⊙→Ω X Y))

    Susp⊙→-Susp-fmap-shom : Susp⊙→-group-structure X Y →ᴳˢ Susp⊙→-group-structure (⊙Susp X) (⊙Susp Y)
    Susp⊙→-Susp-fmap-shom = group-structure-hom ⊙Susp-fmap pres-comp

    Trunc-Susp⊙→-Susp-fmap-hom : Trunc-Susp⊙→-group X Y →ᴳ Trunc-Susp⊙→-group (⊙Susp X) (⊙Susp Y)
    Trunc-Susp⊙→-Susp-fmap-hom = Trunc-group-fmap Susp⊙→-Susp-fmap-shom


open import Agda.Builtin.Reflection
open import Agda.Builtin.Unit

macro

  @0 m : @0 Set → Term → TC ⊤
  m A B =
    bindTC (quoteTC A) λ A →
    unify A B

F : @0 Set → Set
F A = m A


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

module Data.Tuple.Base where

open import Level using (_⊔_)

-- non-dependent pair; failed to reuse _×_
record Pair {a b} (A : Set a) (B : Set b) : Set (a ⊔ b) where
  constructor _,_
  field
    fst : A
    snd : B
{-# FOREIGN GHC type AgdaPair a b c d = (c , d) #-}
-- {-# COMPILE GHC Pair = type MAlonzo.Code.Data.Tuple.AgdaPair #-}
{-# COMPILE GHC Pair = data MAlonzo.Code.Data.Tuple.AgdaPair ((,)) #-}

infixl 5 _∥_

_∥_ = Pair


data D : Set where
  zero : D
  suc  : D → D

postulate
  f : D → D

{-# COMPILE GHC f = \ x -> x #-}


{-# OPTIONS --safe #-}

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.Introductions.Id {{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.Properties.Escape
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.ShapeView
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.Idlemmas
open import Definition.LogicalRelation.Substitution.Introductions.IdUniv
open import Definition.LogicalRelation.Substitution.Introductions.IdNat
open import Definition.LogicalRelation.Substitution.MaybeEmbed
-- open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst
open import Definition.LogicalRelation.Substitution.Introductions.Universe

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

[Id] : ∀ {A t u Γ l lA}
         (⊢Γ : ⊢ Γ)
         ([A] : Γ ⊩⟨ l ⟩ A ^ [ ! , ι lA ])
         ([t] : Γ ⊩⟨ l ⟩ t ∷ A ^ [ ! , ι lA ] / [A])
         ([u] : Γ ⊩⟨ l ⟩ u ∷ A ^ [ ! , ι lA ] / [A])
       → Γ ⊩⟨ l ⟩ Id A t u ^ [ % , ι lA ]
[IdExt] : ∀ {A B t v u w Γ l l' lA}
         (⊢Γ : ⊢ Γ)
         ([A] : Γ ⊩⟨ l ⟩ A ^ [ ! , ι lA ])
         ([B] : Γ ⊩⟨ l' ⟩ B ^ [ ! , ι lA ])
         ([A≡B] : Γ ⊩⟨ l ⟩ A ≡ B ^ [ ! , ι lA ] / [A])
         ([t] : Γ ⊩⟨ l ⟩ t ∷ A ^ [ ! , ι lA ] / [A])
         ([v] : Γ ⊩⟨ l' ⟩ v ∷ B ^ [ ! , ι lA ] / [B])
         ([t≡v] : Γ ⊩⟨ l ⟩ t ≡ v ∷ A ^ [ ! , ι lA ] / [A])
         ([u] : Γ ⊩⟨ l ⟩ u ∷ A ^ [ ! , ι lA ] / [A])
         ([w] : Γ ⊩⟨ l' ⟩ w ∷ B ^ [ ! , ι lA ] / [B])
         ([u≡w] : Γ ⊩⟨ l ⟩ u ≡ w ∷ A ^ [ ! , ι lA ] / [A])
       → Γ ⊩⟨ l ⟩ Id A t u ≡ Id B v w ^ [ % , ι lA ] / [Id] ⊢Γ [A] [t] [u]
[IdExtShape] : ∀ {A B t v u w Γ l l' lA}
         (⊢Γ : ⊢ Γ)
         ([A] : Γ ⊩⟨ l ⟩ A ^ [ ! , ι lA ])
         ([B] : Γ ⊩⟨ l' ⟩ B ^ [ ! , ι lA ])
         (ShapeA : ShapeView Γ l l' A B [ ! , ι lA ] [ ! , ι lA ] [A] [B])
         ([A≡B] : Γ ⊩⟨ l ⟩ A ≡ B ^ [ ! , ι lA ] / [A])
         ([t] : Γ ⊩⟨ l ⟩ t ∷ A ^ [ ! , ι lA ] / [A])
         ([v] : Γ ⊩⟨ l' ⟩ v ∷ B ^ [ ! , ι lA ] / [B])
         ([t≡v] : Γ ⊩⟨ l ⟩ t ≡ v ∷ A ^ [ ! , ι lA ] / [A])
         ([u] : Γ ⊩⟨ l ⟩ u ∷ A ^ [ ! , ι lA ] / [A])
         ([w] : Γ ⊩⟨ l' ⟩ w ∷ B ^ [ ! , ι lA ] / [B])
         ([u≡w] : Γ ⊩⟨ l ⟩ u ≡ w ∷ A ^ [ ! , ι lA ] / [A])
       → Γ ⊩⟨ l ⟩ Id A t u ≡ Id B v w ^ [ % , ι lA ] / [Id] ⊢Γ [A] [t] [u]

[Id] ⊢Γ (ℕᵣ [[ ⊢A , ⊢B , D ]]) [t] [u] = [Id]ℕGen ⊢Γ [[ ⊢A , ⊢B , D ]] [t] [u]

[Id] ⊢Γ (Uᵣ (Uᵣ r ¹ l< () d)) [t] [u]

[Id] {A} {t} {u} {Γ} {ι .¹} {.¹} ⊢Γ (Uᵣ (Uᵣ rU ⁰ emb< PE.refl [[ ⊢A , ⊢B , D ]])) [t] [u] = [Id]UGen {A} {t} {u} {Γ} ⊢Γ (Uᵣ rU ⁰ emb< PE.refl [[ ⊢A , ⊢B , D ]]) [t] [u]

[Id] {A} {t} {u} {Γ} {l} {lA} ⊢Γ (ne′ K [[ ⊢A , ⊢B , D ]] neK K≡K) [t] [u] =
  let
    [A] = ne′ K [[ ⊢A , ⊢B , D ]] neK K≡K
    ⊢tA = escapeTerm {l = l} [A] [t]
    ⊢uA = escapeTerm {l = l} [A] [u]
    [K] = neu {l = l} neK ⊢B K≡K
    [A]′ , [A≡K] = redSubst* D [K]
    [t:K] = convTerm₁ [A]′ [K] [A≡K] (irrelevanceTerm [A] [A]′ [t])
    [u:K] = convTerm₁ [A]′ [K] [A≡K] (irrelevanceTerm [A] [A]′ [u])
    t≡t = escapeTermEq [K] (reflEqTerm [K] [t:K])
    u≡u = escapeTermEq [K] (reflEqTerm [K] [u:K])
  in ne′ (Id K t u) (redSProp (IdRed*Term ⊢tA ⊢uA [[ ⊢A , ⊢B , D ]])) (Idₙ neK) (~-Id K≡K t≡t u≡u)

[Id] {A} {t} {u} {Γ} {l} {lA} ⊢Γ (Πᵣ′ rF lF lG lF≤ lG≤ F G [[ ⊢A , ⊢B , D ]] ⊢F ⊢G A≡A [F] [G] G-ext)
  (f , [[ ⊢t , ⊢f , Df ]] , funf , f≡f , [fext] , [f]) (g , [[ ⊢u , ⊢g , Dg ]] , fung , g≡g , [gext] , [g]) =
  let
    ⊢tA = conv ⊢t (sym (subset* D))
    ⊢uA = conv ⊢u (sym (subset* D))

    [F0] : Γ ⊩⟨ l ⟩ F ^ [ rF , ι lF ]
    [F0] = PE.subst (λ X → Γ ⊩⟨ l ⟩ X ^ [ rF , ι lF ]) (wk-id F) ([F] Twk.id ⊢Γ)

    ⊢idG : Γ ∙ F ^ [ rF , ι lF ] ⊢ Id G (wk1 t ∘ var 0 ^ lA) (wk1 u ∘ var 0 ^ lA) ^ [ % , ι lG ]
    ⊢idG = let
        ⊢t∘0 = PE.subst (λ X → _ ⊢ wk1 t ∘ var 0 ^ _ ∷ X ^ [ ! , ι lG ]) (wkSingleSubstId G)
          (Twk.wkTerm (Twk.step Twk.id) (⊢Γ ∙ ⊢F) ⊢t ∘ⱼ var (⊢Γ ∙ ⊢F) here)
        ⊢u∘0 = PE.subst (λ X → _ ⊢ wk1 u ∘ var 0 ^ _ ∷ X ^ [ ! , ι lG ]) (wkSingleSubstId G)
          (Twk.wkTerm (Twk.step Twk.id) (⊢Γ ∙ ⊢F) ⊢u ∘ⱼ var (⊢Γ ∙ ⊢F) here)
      in univ (Idⱼ (un-univ ⊢G) ⊢t∘0 ⊢u∘0)

    ⊢funext : Γ ⊢ Π F ^ rF ° lF ▹ (Id G ((wk1 t) ∘ (var 0) ^ lA) ((wk1 u) ∘ (var 0) ^ lA)) ° lG ° lA ^ [ % , ι lA ]
    ⊢funext = univ (Πⱼ lF≤ ▹ lG≤ ▹ un-univ ⊢F ▹ un-univ ⊢idG)

    Did : Γ ⊢ Id A t u ⇒* Π F ^ rF ° lF ▹ (Id G ((wk1 t) ∘ (var 0) ^ lA) ((wk1 u) ∘ (var 0) ^ lA)) ° lG ° lA ^ [ % , ι lA ]
    Did =  IdRed* ⊢tA ⊢uA D ⇨* (univ (Id-Π lF≤ lG≤ (un-univ ⊢F) (un-univ ⊢G) ⊢t ⊢u) ⇨ id ⊢funext)

    [idG] : ∀ {ρ Δ a}
          → ([ρ] : Twk._∷_⊆_ ρ Δ Γ) → (⊢Δ : ⊢ Δ)
          → (Δ ⊩⟨ l ⟩ a ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ)
          → Δ ⊩⟨ l ⟩ wk (lift ρ) (Id G (wk1 t ∘ var 0 ^ lA) (wk1 u ∘ var 0 ^ lA)) [ a ] ^ [ % , ι lG ]
    [idG] {ρ} {Δ} {a} [ρ] ⊢Δ [a] =
      let
        [t∘a] : Δ ⊩⟨ l ⟩ wk ρ t ∘ a ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [G] [ρ] ⊢Δ [a]
        [t∘a] = proj₁ (redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Df))
          ([G] [ρ] ⊢Δ [a]) ([f] [ρ] ⊢Δ [a]))
        [u∘a] : Δ ⊩⟨ l ⟩ wk ρ u ∘ a ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [G] [ρ] ⊢Δ [a]
        [u∘a] = proj₁ (redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Dg))
          ([G] [ρ] ⊢Δ [a]) ([g] [ρ] ⊢Δ [a]))
        [Id] : Δ ⊩⟨ l ⟩ (Id (wk (lift ρ) G [ a ]) (wk ρ t ∘ a ^ lA) (wk ρ u ∘ a ^ lA)) ^ [ % , ι lG ]
        [Id] = [Id] ⊢Δ ([G] [ρ] ⊢Δ [a]) [t∘a] [u∘a]
      in PE.subst₂ (λ X Y → Δ ⊩⟨ l ⟩ (Id _ (X ∘ a ^ lA) (Y ∘ a ^ lA)) ^ [ % , ι lG ]) (PE.sym (irrelevant-subst′ ρ t a)) (PE.sym (irrelevant-subst′ ρ u a)) [Id]

    [idG0] : Γ ∙ F ^ [ rF , ι lF ] ⊩⟨ l ⟩ (Id G (wk1 t ∘ var 0 ^ lA) (wk1 u ∘ var 0 ^ lA)) ^ [ % , ι lG ]
    [idG0] = PE.subst₃ (λ X Y Z → _ ⊩⟨ l ⟩ (Id X (Y ∘ var 0 ^ lA) (Z ∘ var 0 ^ lA)) ^ _)
      (wkSingleSubstId G) (wkSingleSubstId (wk1 t)) (wkSingleSubstId (wk1 u))
      ([idG] {step id} {Γ ∙ F ^ [ rF , ι lF ]} {var 0} (Twk.step Twk.id)
       (⊢Γ ∙ ⊢F) (neuTerm ([F] (Twk.step Twk.id) (⊢Γ ∙ ⊢F)) (var 0)
         (var (⊢Γ ∙ ⊢F) here) (~-var (var (⊢Γ ∙ ⊢F) here))))

    [idGext] : ∀ {ρ Δ a b}
          → ([ρ] : Twk._∷_⊆_ ρ Δ Γ)
          → (⊢Δ : ⊢ Δ)
          → ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ)
          → ([b] : Δ ⊩⟨ l ⟩ b ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ)
          → ([a≡b] : Δ ⊩⟨ l ⟩ a ≡ b ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ)
          → Δ ⊩⟨ l ⟩ wk (lift ρ) (Id G (wk1 t ∘ var 0 ^ lA) (wk1 u ∘ var 0 ^ lA)) [ a ] ≡ wk (lift ρ) (Id G (wk1 t ∘ var 0 ^ lA) (wk1 u ∘ var 0 ^ lA)) [ b ] ^ [ % , ι lG ] / [idG] [ρ] ⊢Δ [a]
    [idGext] {ρ} {Δ} {a} {b} [ρ] ⊢Δ [a] [b] [a≡b] =
      let
        [Ga] = [G] [ρ] ⊢Δ [a]
        [Gb] = [G] [ρ] ⊢Δ [b]
        [t∘a] , [ta≡fa] = redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Df))
          [Ga] ([f] [ρ] ⊢Δ [a])
        [u∘a] , [ua≡ga] = redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Dg))
          [Ga] ([g] [ρ] ⊢Δ [a])
        [Ga≡Gb] : Δ ⊩⟨ l ⟩ wk (lift ρ) G [ a ] ≡ wk (lift ρ) G [ b ] ^ [ ! , ι lG ] / [Ga]
        [Ga≡Gb] = G-ext [ρ] ⊢Δ [a] [b] [a≡b]
        [t∘b:Gb] , [tb≡fb:Gb] = redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [b]) (Twk.wkRed*Term [ρ] ⊢Δ Df))
          [Gb] ([f] [ρ] ⊢Δ [b])
        [t∘b] : Δ ⊩⟨ l ⟩ wk ρ t ∘ b ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]
        [t∘b] = convTerm₂ [Ga] [Gb] [Ga≡Gb] [t∘b:Gb]
        [u∘b:Gb] , [ub≡gb:Gb] = redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [b]) (Twk.wkRed*Term [ρ] ⊢Δ Dg))
          [Gb] ([g] [ρ] ⊢Δ [b])
        [u∘b] : Δ ⊩⟨ l ⟩ wk ρ u ∘ b ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]
        [u∘b] = convTerm₂ [Ga] [Gb] [Ga≡Gb] [u∘b:Gb]
        [ta≡tb] : Δ ⊩⟨ l ⟩ wk ρ t ∘ a ^ lA ≡ wk ρ t ∘ b ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]
        [ta≡tb] = transEqTerm [Ga] (transEqTerm [Ga] [ta≡fa] ([fext] [ρ] ⊢Δ [a] [b] [a≡b])) (symEqTerm [Ga] (convEqTerm₂ [Ga] [Gb] [Ga≡Gb] [tb≡fb:Gb]))
        [ua≡ub] : Δ ⊩⟨ l ⟩ wk ρ u ∘ a ^ lA ≡ wk ρ u ∘ b ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]
        [ua≡ub] = transEqTerm [Ga] (transEqTerm [Ga] [ua≡ga] ([gext] [ρ] ⊢Δ [a] [b] [a≡b])) (symEqTerm [Ga] (convEqTerm₂ [Ga] [Gb] [Ga≡Gb] [ub≡gb:Gb]))
        [IdExtG] : Δ ⊩⟨ l ⟩ (Id (wk (lift ρ) G [ a ]) (wk ρ t ∘ a ^ lA) (wk ρ u ∘ a ^ lA)) ≡ (Id (wk (lift ρ) G [ b ]) (wk ρ t ∘ b ^ lA) (wk ρ u ∘ b ^ lA)) ^ [ % , ι lG ] / [Id] ⊢Δ [Ga] [t∘a] [u∘a]
        [IdExtG] = [IdExt] ⊢Δ [Ga] [Gb] [Ga≡Gb] [t∘a] [t∘b:Gb] [ta≡tb] [u∘a] [u∘b:Gb] [ua≡ub]
      in irrelevanceEq″
        (PE.cong₂ (λ X Y → Id _ (X ∘ a ^ lA) (Y ∘ a ^ lA)) (PE.sym (irrelevant-subst′ ρ t a)) (PE.sym (irrelevant-subst′ ρ u a)))
        (PE.cong₂ (λ X Y → Id _ (X ∘ b ^ lA) (Y ∘ b ^ lA)) (PE.sym (irrelevant-subst′ ρ t b)) (PE.sym (irrelevant-subst′ ρ u b)))
        PE.refl PE.refl
        ([Id] ⊢Δ [Ga] [t∘a] [u∘a]) ([idG] [ρ] ⊢Δ [a]) [IdExtG]
  in Πᵣ (Πᵣ rF lF lG lF≤ lG≤ F (Id G ((wk1 t) ∘ (var 0) ^ lA) ((wk1 u) ∘ (var 0) ^ lA))
      [[ univ (Idⱼ (un-univ ⊢A) ⊢tA ⊢uA) , ⊢funext , Did ]]
      ⊢F ⊢idG
      (≅-univ (≅ₜ-Π-cong lF≤ lG≤ ⊢F (≅-un-univ (escapeEqRefl [F0]))
        (≅-un-univ (escapeEqRefl [idG0]))))
      [F] [idG] [idGext])

[Id] ⊢Γ (emb {l′ = ι ⁰} emb< [A]) [t] [u] = emb emb< ([Id] ⊢Γ [A] [t] [u])
[Id] ⊢Γ (emb {l′ = ι ¹} ∞< [A]) [t] [u] = emb ∞< ([Id] ⊢Γ [A] [t] [u])

[IdExtShape] {A} {B} {t} {v} {u} {w} {Γ} {.(ι ¹)} {.(ι ¹)} {lA} ⊢Γ (Uᵣ (Uᵣ rU ⁰ emb< PE.refl d)) (Uᵣ (Uᵣ r₁ ⁰ emb< PE.refl d₁)) (Uᵥ ._ ._) [A≡B] [t] [v] [t≡v] [u] [w] [u≡w] =
  [IdExt]UGen {A} {B} {t} {v} {u} {w} {Γ} ⊢Γ (Uᵣ rU ⁰ emb< PE.refl d) (Uᵣ r₁ ⁰ emb< PE.refl d₁) [A≡B] [t] [v] [t≡v] [u] [w] [u≡w]

[IdExtShape] {A} {B} {t} {v} {u} {w} {Γ} {l} {l'} {lA}  ⊢Γ (ne′ K [[ ⊢A , ⊢B , D ]] neK K≡K) (ne neB) (ne ._ .neB) (ne₌ M [[ ⊢A′ , ⊢B′ ,  D′ ]] neM K≡M) [t] [t′] [t≡t′] [u] [u′] [u≡u′] =
  let
    [A] = (ne′ K [[ ⊢A , ⊢B , D ]] neK K≡K)
    ⊢t′A′ = escapeTerm {l = l'} (ne neB) [t′]
    ⊢u′A′ = escapeTerm {l = l'} (ne neB) [u′]
    A≡K = subset* D
    t≡t′ : Γ ⊢ t ≅ v ∷ K ^ [ ! , ι lA ]
    t≡t′ = ≅-conv (escapeTermEq {l = l} [A] [t≡t′]) A≡K
    u≡u′ = ≅-conv (escapeTermEq {l = l} [A] [u≡u′]) A≡K
  in ne₌ (Id M v w) (univ:⇒*: (IdRed*Term ⊢t′A′ ⊢u′A′ [[ ⊢A′ , ⊢B′ , D′ ]]))
         (Idₙ neM) (~-Id K≡M t≡t′ u≡u′)

[IdExtShape] {A} {B} {t} {v} {u} {w} {Γ} {l} {l'} ⊢Γ (ℕᵣ [[ ⊢A , ⊢B , D ]]) (ℕᵣ [[ ⊢A₁ , ⊢B₁ , D₁ ]]) (ℕᵥ ._ ._) [A≡B] [t] [v] [t≡v] [u] [w] [u≡w] =
  [IdExt]ℕGen {A} {B} {t} {v} {u} {w} {Γ} {l} {l'} ⊢Γ [[ ⊢A , ⊢B , D ]] [[ ⊢A₁ , ⊢B₁ , D₁ ]] [A≡B] [t] [v] [t≡v] [u] [w] [u≡w]

[IdExtShape] {A} {A′} {t} {t′} {u} {u′} {Γ} {l} {l'} {lA} ⊢Γ (Πᵣ′ rF lF lG lF≤ lG≤ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (Πᵣ′ rF′ lF′ lG′ lF≤′ lG≤′ F′ G′ [[ ⊢A′ , ⊢B′ , D′ ]] ⊢F′ ⊢G′ A′≡A′ [F′] [G′] G′-ext)
  (Πᵥ .(Πᵣ rF lF lG lF≤ lG≤ F G D ⊢F ⊢G A≡A [F] [G] G-ext) .(Πᵣ rF′ lF′ lG′ lF≤′ lG≤′ F′ G′ [[ ⊢A′ , ⊢B′ , D′ ]] ⊢F′ ⊢G′ A′≡A′ [F′] [G′] G′-ext))
   (Π₌ F′₀ G′₀ D′₀ A≡B [F≡F′₀] [G≡G′₀])
   [t] [t′] (f₀ , f′₀ , [[ ⊢t , ⊢f₀ , Df₀ ]] , [[ ⊢t′ , ⊢f′₀ , Df′₀ ]] , funf₀ , funf′₀ , f₀≡f′₀ , [t]′ , [t′]′ , [f₀≡f′₀])
   [u] [u′] (g₀ , g′₀ , [[ ⊢u , ⊢g₀ , Dg₀ ]] , [[ ⊢u′ , ⊢g′₀ , Dg′₀ ]] , fung₀ , fung′₀ , g₀≡g′₀ , [u]′ , [u′]′ , [g₀≡g′₀]) =
  let
    F′≡F′₀ , rF′≡rF , lF′≡lF , G′≡G′₀ , lG′≡lG , _ = Π-PE-injectivity (whrDet* (D′ , Whnf.Πₙ) (D′₀ , Whnf.Πₙ))
    [F≡F′] = PE.subst (λ X → ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ) → Δ ⊩⟨ l ⟩ wk ρ F ≡ wk ρ X ^ [ rF , _ ] / [F] [ρ] ⊢Δ) (PE.sym F′≡F′₀) [F≡F′₀]
    [G≡G′] = PE.subst (λ X → ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ) → ([a] : _) → Δ ⊩⟨ l ⟩ wk (lift ρ) G [ a ] ≡ wk (lift ρ) X [ a ] ^ [ _ , _ ] / [G] [ρ] ⊢Δ [a]) (PE.sym G′≡G′₀) [G≡G′₀]

    f , [[ ⊢t , _ , Df ]] , funf , _ , _ , [f] = [t]
    f₀≡f = whrDet*Term (Df₀ , functionWhnf funf₀) (Df , functionWhnf funf)
    f′ , [[ ⊢t′ , _ , Df′ ]] , funf′ , _ , _ , [f′] = [t′]
    f′₀≡f′ = whrDet*Term (Df′₀ , functionWhnf funf′₀) (Df′ , functionWhnf funf′)
    g , [[ ⊢u , _ , Dg ]] , fung , _ , _ , [g] = [u]
    g₀≡g = whrDet*Term (Dg₀ , functionWhnf fung₀) (Dg , functionWhnf fung)
    g′ , [[ ⊢u′ , _ , Dg′ ]] , fung′ , _ , _ , [g′] = [u′]
    g′₀≡g′ = whrDet*Term (Dg′₀ , functionWhnf fung′₀) (Dg′ , functionWhnf fung′)

    [text] = λ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ) → redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Df))
          ([G] [ρ] ⊢Δ [a]) ([f] [ρ] ⊢Δ [a])
    [t′ext] = λ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ l' ⟩ a ∷ wk ρ F′ ^ [ rF′ , ι lF′ ] / [F′] [ρ] ⊢Δ) → redSubst*Term
          (appRed* (escapeTerm ([F′] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Df′))
          ([G′] [ρ] ⊢Δ [a]) ([f′] [ρ] ⊢Δ [a])
    [uext] = λ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ) → redSubst*Term
          (appRed* (escapeTerm ([F] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Dg))
          ([G] [ρ] ⊢Δ [a]) ([g] [ρ] ⊢Δ [a])
    [u′ext] = λ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ l' ⟩ a ∷ wk ρ F′ ^ [ rF′ , ι lF′ ] / [F′] [ρ] ⊢Δ) → redSubst*Term
          (appRed* (escapeTerm ([F′] [ρ] ⊢Δ) [a]) (Twk.wkRed*Term [ρ] ⊢Δ Dg′))
          ([G′] [ρ] ⊢Δ [a]) ([g′] [ρ] ⊢Δ [a])

    [idG] = λ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ) →
      PE.subst₂ (λ X Y → Δ ⊩⟨ l ⟩ Id (subst (sgSubst a) (wk (lift ρ) G)) (X ∘ a ^ lA) (Y ∘ a ^ lA) ^ [ % , ι lG ])
        (PE.sym (irrelevant-subst′ ρ t a)) (PE.sym (irrelevant-subst′ ρ u a))
        ([Id] ⊢Δ ([G] [ρ] ⊢Δ [a]) (proj₁ ([text] [ρ] ⊢Δ [a])) (proj₁ ([uext] [ρ] ⊢Δ [a])))
    [idG≡idG′] : ∀ {ρ Δ a}
          → ([ρ] : Twk._∷_⊆_ ρ Δ Γ)
          → (⊢Δ : ⊢ Δ)
          → ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ F ^ [ rF , ι lF ] / [F] [ρ] ⊢Δ)
          → Δ ⊩⟨ l ⟩ wk (lift ρ) (Id G (wk1 t ∘ var 0 ^ lA) (wk1 u ∘ var 0 ^ lA)) [ a ] ≡ wk (lift ρ) (Id G′ (wk1 t′ ∘ var 0 ^ lA) (wk1 u′ ∘ var 0 ^ lA)) [ a ] ^ [ % , ι lG ] / [idG] [ρ] ⊢Δ [a]
    [idG≡idG′] {ρ} {Δ} {a} [ρ] ⊢Δ [a] =
      let
        [aF′] = convTerm₁′ (PE.sym rF′≡rF) (PE.cong ι (PE.sym lF′≡lF)) ([F] [ρ] ⊢Δ) ([F′] [ρ] ⊢Δ) ([F≡F′] [ρ] ⊢Δ) [a]
        [Ga] = [G] [ρ] ⊢Δ [a]
        [G′a] = [G′] [ρ] ⊢Δ [aF′]
        [Ga≡G′a] : Δ ⊩⟨ l ⟩ wk (lift ρ) G [ a ] ≡ wk (lift ρ) G′ [ a ] ^ [ ! , ι lG ] / [Ga]
        [Ga≡G′a] = [G≡G′] [ρ] ⊢Δ [a]
        [t∘a] , [ta≡fa] = [text] [ρ] ⊢Δ [a]
        [t′∘a] , [t′a≡f′a] = [t′ext] [ρ] ⊢Δ [aF′]
        [fa≡f′a] = PE.subst₂ (λ X Y → Δ ⊩⟨ l ⟩ wk ρ X ∘ a ^ lA ≡ wk ρ Y ∘ a ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]) f₀≡f f′₀≡f′ ([f₀≡f′₀] [ρ] ⊢Δ [a])
        [ta≡t′a] : Δ ⊩⟨ l ⟩ wk ρ t ∘ a ^ lA ≡ wk ρ t′ ∘ a ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]
        [ta≡t′a] = transEqTerm [Ga] (transEqTerm [Ga] [ta≡fa] [fa≡f′a]) (symEqTerm [Ga] (convEqTerm₂′ PE.refl (PE.cong ι (PE.sym lG′≡lG)) [Ga] [G′a] [Ga≡G′a] [t′a≡f′a]))
        [u∘a] , [ua≡ga] = [uext] [ρ] ⊢Δ [a]
        [u′∘a] , [u′a≡g′a] = [u′ext] [ρ] ⊢Δ [aF′]
        [ga≡g′a] = PE.subst₂ (λ X Y → Δ ⊩⟨ l ⟩ wk ρ X ∘ a ^ lA ≡ wk ρ Y ∘ a ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]) g₀≡g g′₀≡g′ ([g₀≡g′₀] [ρ] ⊢Δ [a])
        [ua≡u′a] : Δ ⊩⟨ l ⟩ wk ρ u ∘ a ^ lA ≡ wk ρ u′ ∘ a ^ lA ∷ wk (lift ρ) G [ a ] ^ [ ! , ι lG ] / [Ga]
        [ua≡u′a] = transEqTerm [Ga] (transEqTerm [Ga] [ua≡ga] [ga≡g′a]) (symEqTerm [Ga] (convEqTerm₂′ PE.refl (PE.cong ι (PE.sym lG′≡lG)) [Ga] [G′a] [Ga≡G′a] [u′a≡g′a]))
        [G′a]′ = irrelevance′′ PE.refl PE.refl (PE.cong ι lG′≡lG) [G′a]
        [t′∘a]′ = irrelevanceTerm′ PE.refl PE.refl (PE.cong ι lG′≡lG) [G′a] [G′a]′ [t′∘a]
        [u′∘a]′ = irrelevanceTerm′ PE.refl PE.refl (PE.cong ι lG′≡lG) [G′a] [G′a]′ [u′∘a]
        [idG≡idG′]′ : Δ ⊩⟨ l ⟩ Id (wk (lift ρ) G [ a ]) (wk ρ t ∘ a ^ lA) (wk ρ u ∘ a ^ lA) ≡ Id (wk (lift ρ) G′ [ a ]) (wk ρ t′ ∘ a ^ lA) (wk ρ u′ ∘ a ^ lA) ^ [ % , ι lG ] / [Id] ⊢Δ [Ga] [t∘a] [u∘a]
        [idG≡idG′]′ = [IdExt] ⊢Δ [Ga] [G′a]′ [Ga≡G′a] [t∘a] [t′∘a]′ [ta≡t′a] [u∘a] [u′∘a]′ [ua≡u′a]
      in irrelevanceEq″ (PE.cong₂ (λ X Y → Id (wk (lift ρ) G [ a ]) (X ∘ a ^ lA) (Y ∘ a ^ lA)) (PE.sym (irrelevant-subst′ ρ t a)) (PE.sym (irrelevant-subst′ ρ u a)))
        (PE.cong₂ (λ X Y → Id (wk (lift ρ) G′ [ a ]) (X ∘ a ^ lA) (Y ∘ a ^ lA)) (PE.sym (irrelevant-subst′ ρ t′ a)) (PE.sym (irrelevant-subst′ ρ u′ a)))
        PE.refl PE.refl
        ([Id] ⊢Δ [Ga] [t∘a] [u∘a]) ([idG] [ρ] ⊢Δ [a]) [idG≡idG′]′

    [var0] = neuTerm ([F] (Twk.step Twk.id) (⊢Γ ∙ ⊢F)) (var 0) (var (⊢Γ ∙ ⊢F) here) (~-var (var (⊢Γ ∙ ⊢F) here))

    ⊢idG≡idG′₀ : Γ ∙ F ^ [ rF , ι lF ] ⊢ (Id G (wk1 t ∘ var 0 ^ lA) (wk1 u ∘ var 0 ^ lA)) ≅ (Id G′ (wk1 t′ ∘ var 0 ^ lA) (wk1 u′ ∘ var 0 ^ lA)) ^ [ % , ι lG ]
    ⊢idG≡idG′₀ = PE.subst₃ (λ X Y Z → _ ⊢ (Id X (Y ∘ var 0 ^ lA) (Z ∘ var 0 ^ lA)) ≅ _ ^ _)
      (wkSingleSubstId G) (wkSingleSubstId (wk1 t)) (wkSingleSubstId (wk1 u))
      (PE.subst₃ (λ X Y Z → _ ⊢ _ ≅ (Id X (Y ∘ var 0 ^ lA) (Z ∘ var 0 ^ lA)) ^ _)
        (wkSingleSubstId G′) (wkSingleSubstId (wk1 t′)) (wkSingleSubstId (wk1 u′))
        (escapeEq ([idG] (Twk.step Twk.id) (⊢Γ ∙ ⊢F) [var0]) ([idG≡idG′] {step id} {Γ ∙ F ^ [ rF , ι lF ]} {var 0} (Twk.step Twk.id) (⊢Γ ∙ ⊢F) [var0])))

    ⊢F≡F′ = PE.subst₂ (λ X Y → _ ⊢ X ≅ Y ^ _) (wk-id F) (PE.trans (wk-id F′₀) (PE.sym F′≡F′₀))
      (escapeEq ([F] Twk.id ⊢Γ) ([F≡F′₀] Twk.id ⊢Γ))

    [A′] = (Πᵣ′ rF′ lF′ lG′ lF≤′ lG≤′ F′ G′ [[ ⊢A′ , ⊢B′ , D′ ]] ⊢F′ ⊢G′ A′≡A′ [F′] [G′] G′-ext)
    ⊢t′A′ = escapeTerm {l = l'} [A′] [t′]
    ⊢u′A′ = escapeTerm {l = l'} [A′] [u′]

    ⊢t′∘a = PE.subst (λ X → _ ⊢ wk1 t′ ∘ var 0 ^ lA ∷ X ^ [ ! , ι lG′ ]) (wkSingleSubstId G′)
      (Twk.wkTerm (Twk.step Twk.id) (⊢Γ ∙ ⊢F′) ⊢t′ ∘ⱼ var (⊢Γ ∙ ⊢F′) here)
    ⊢u′∘a = PE.subst (λ X → _ ⊢ wk1 u′ ∘ var 0 ^ lA ∷ X ^ [ ! , ι lG′ ]) (wkSingleSubstId G′)
      (Twk.wkTerm (Twk.step Twk.id) (⊢Γ ∙ ⊢F′) ⊢u′ ∘ⱼ var (⊢Γ ∙ ⊢F′) here)
    ⊢funext′ : Γ ⊢ Π F′ ^ rF′ ° lF′ ▹ Id G′ (wk1 t′ ∘ var 0 ^ lA) (wk1 u′ ∘ var 0 ^ lA) ° lG′ ° lA ^ [ % , ι lA ]
    ⊢funext′ = univ (Πⱼ lF≤′ ▹ lG≤′ ▹ un-univ ⊢F′ ▹ Idⱼ (un-univ ⊢G′) ⊢t′∘a ⊢u′∘a)

    Did : Γ ⊢ Id A′ t′ u′ ⇒* Π F′ ^ rF′ ° lF′ ▹ (Id G′ ((wk1 t′) ∘ (var 0) ^ lA) ((wk1 u′) ∘ (var 0) ^ lA)) ° lG′ ° lA ^ [ % , ι lA ]
    Did = IdRed* ⊢t′A′ ⊢u′A′ D′ ⇨* ((univ (Id-Π lF≤′ lG≤′ (un-univ ⊢F′) (un-univ ⊢G′) ⊢t′ ⊢u′)) ⇨ id ⊢funext′)

  in Π₌ F′ (Id G′ ((wk1 t′) ∘ (var 0) ^ lA) ((wk1 u′) ∘ (var 0) ^ lA))
         (PE.subst (λ X → Γ ⊢ Id A′ t′ u′ ⇒* Π F′ ^ rF ° lF ▹ _ ° X ° lA ^ [ % , ι lA ]) lG′≡lG
           (PE.subst (λ X → Γ ⊢ Id A′ t′ u′ ⇒* Π F′ ^ rF ° X ▹ _ ° lG′ ° lA ^ [ % , ι lA ]) lF′≡lF
             (PE.subst (λ X → Γ ⊢ Id A′ t′ u′ ⇒* Π F′ ^ X ° lF′ ▹ _ ° lG′ ° lA ^ [ % , ι lA ]) rF′≡rF Did)))
        (≅-univ (≅ₜ-Π-cong lF≤ lG≤ ⊢F (≅-un-univ ⊢F≡F′) (≅-un-univ ⊢idG≡idG′₀))) [F≡F′] [idG≡idG′]

[IdExtShape] {A} {B} {t} {t′} {u} {u′} {Γ} ⊢Γ (emb emb< [A]) [B] (emb⁰¹ {p = .[A]} ShapeA) [A≡B] [t] [v] [t≡v] [u] [w] [u≡w] =
  [IdExtShape] ⊢Γ [A] [B] ShapeA [A≡B] [t] [v] [t≡v] [u] [w] [u≡w]
[IdExtShape] {A} {B} {t} {t′} {u} {u′} {Γ} ⊢Γ [A] (emb emb< [B]) (emb¹⁰ {q = .[B]} ShapeA) [A≡B] [t] [v] [t≡v] [u] [w] [u≡w] =
  [IdExtShape] ⊢Γ [A] [B] ShapeA [A≡B] [t] [v] [t≡v] [u] [w] [u≡w]
[IdExtShape] {A} {B} {t} {t′} {u} {u′} {Γ} ⊢Γ (emb ∞< [A]) [B] (emb¹∞ {p = .[A]} ShapeA) [A≡B] [t] [v] [t≡v] [u] [w] [u≡w] =
  [IdExtShape] ⊢Γ [A] [B] ShapeA [A≡B] [t] [v] [t≡v] [u] [w] [u≡w]
[IdExtShape] {A} {B} {t} {t′} {u} {u′} {Γ} ⊢Γ [A] (emb ∞< [B]) (emb∞¹ {q = .[B]} ShapeA) [A≡B] [t] [v] [t≡v] [u] [w] [u≡w] =
  [IdExtShape] ⊢Γ [A] [B] ShapeA [A≡B] [t] [v] [t≡v] [u] [w] [u≡w]

[IdExt] {A} {A′} {t} {t′} {u} {u′} {Γ} ⊢Γ [A] [A′] [A≡A′] [t] [t′] [t≡t′] [u] [u′] [u≡u′] =
  [IdExtShape] {A} {A′} {t} {t′} {u} {u′} {Γ} ⊢Γ [A] [A′] (goodCases [A] [A′] [A≡A′]) [A≡A′] [t] [t′] [t≡t′] [u] [u′] [u≡u′]

Idᵛ-min : ∀ {A t u Γ l}
       ([Γ] : ⊩ᵛ Γ)
       ([A] : Γ ⊩ᵛ⟨ ι l ⟩ A ^ [ ! , ι l ] / [Γ])
       ([t] : Γ ⊩ᵛ⟨ ι l ⟩ t ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([u] : Γ ⊩ᵛ⟨ ι l ⟩ u ∷ A ^ [ ! , ι l ] / [Γ] / [A])
     → Γ ⊩ᵛ⟨ ι l ⟩ Id A t u ^ [ % , ι l ] / [Γ]
Idᵛ-min [Γ] [A] [t] [u] ⊢Δ [σ] =
  ([Id] ⊢Δ (proj₁ ([A] ⊢Δ [σ])) (proj₁ ([t] ⊢Δ [σ])) (proj₁ ([u] ⊢Δ [σ]))) ,
  (λ [σ′] [σ≡σ′] → [IdExt] ⊢Δ (proj₁ ([A] ⊢Δ [σ])) (proj₁ ([A] ⊢Δ [σ′])) (proj₂ ([A] ⊢Δ [σ]) [σ′] [σ≡σ′])
                             (proj₁ ([t] ⊢Δ [σ])) (proj₁ ([t] ⊢Δ [σ′])) (proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′])
                             (proj₁ ([u] ⊢Δ [σ])) (proj₁ ([u] ⊢Δ [σ′])) (proj₂ ([u] ⊢Δ [σ]) [σ′] [σ≡σ′]))

Idᵛ : ∀ {A t u Γ l}
       ([Γ] : ⊩ᵛ Γ)
       ([A] : Γ ⊩ᵛ⟨ ∞ ⟩ A ^ [ ! , ι l ] / [Γ])
       ([t] : Γ ⊩ᵛ⟨ ∞ ⟩ t ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([u] : Γ ⊩ᵛ⟨ ∞ ⟩ u ∷ A ^ [ ! , ι l ] / [Γ] / [A])
     → Γ ⊩ᵛ⟨ ∞ ⟩ Id A t u ^ [ % , ι l ] / [Γ]
Idᵛ [Γ] [A] [t] [u] ⊢Δ [σ] =
  ([Id] ⊢Δ (proj₁ ([A] ⊢Δ [σ])) (proj₁ ([t] ⊢Δ [σ])) (proj₁ ([u] ⊢Δ [σ]))) ,
  (λ [σ′] [σ≡σ′] → [IdExt] ⊢Δ (proj₁ ([A] ⊢Δ [σ])) (proj₁ ([A] ⊢Δ [σ′])) (proj₂ ([A] ⊢Δ [σ]) [σ′] [σ≡σ′])
                             (proj₁ ([t] ⊢Δ [σ])) (proj₁ ([t] ⊢Δ [σ′])) (proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′])
                             (proj₁ ([u] ⊢Δ [σ])) (proj₁ ([u] ⊢Δ [σ′])) (proj₂ ([u] ⊢Δ [σ]) [σ′] [σ≡σ′]))

Idᵗᵛ-min : ∀ {A t u Γ l}
       ([Γ] : ⊩ᵛ Γ)
       ([A] : Γ ⊩ᵛ⟨ ι l ⟩ A ^ [ ! , ι l ] / [Γ])
       ([t] : Γ ⊩ᵛ⟨ ι l ⟩ t ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([u] : Γ ⊩ᵛ⟨ ι l ⟩ u ∷ A ^ [ ! , ι l ] / [Γ] / [A])
     → Γ ⊩ᵛ⟨ next l ⟩ Id A t u ∷ SProp l ^ [ ! , next l ] / [Γ] / Uᵛgen (≡is≤ PE.refl) <next [Γ]
Idᵗᵛ-min {A} {t} {u} {_} {l} [Γ] [A] [t] [u] =
  let [U] = Uᵛgen (≡is≤ PE.refl) <next [Γ]
  in un-univᵛ {A = Id A t u} [Γ] [U] (Idᵛ-min {A} {t} {u} [Γ] [A] [t] [u])

Idᵗᵛ : ∀ {A t u Γ l}
       ([Γ] : ⊩ᵛ Γ) →
       let [UA] = maybeEmbᵛ {A = U _} [Γ] (Uᵛ <next [Γ])
           [U] = maybeEmbᵛ {A = SProp _} [Γ] (Uᵛ <next [Γ])
       in ([A] : Γ ⊩ᵛ⟨ ∞ ⟩ A ^ [ ! , ι l ] / [Γ])
          ([t] : Γ ⊩ᵛ⟨ ∞ ⟩ t ∷ A ^ [ ! , ι l ] / [Γ] / [A])
          ([u] : Γ ⊩ᵛ⟨ ∞ ⟩ u ∷ A ^ [ ! , ι l ] / [Γ] / [A])
          ([A]t : Γ ⊩ᵛ⟨ ∞ ⟩ A ∷ Univ ! l ^ [ ! , next l ] / [Γ] / [UA])
          → Γ ⊩ᵛ⟨ ∞ ⟩ Id A t u ∷ SProp l ^ [ ! , next l ] / [Γ] / [U]
Idᵗᵛ {A} {t} {u} {_} {l} [Γ] [A] [t] [u] [A]t =
  let [UA] = maybeEmbᵛ {A = U _} [Γ] (Uᵛ <next [Γ])
      [A]' = univᵛ {A = A} [Γ] (≡is≤ PE.refl) [UA] [A]t
      [t]' = S.irrelevanceTerm {A = A} {t = t} [Γ] [Γ] [A] [A]' [t]
      [u]' = S.irrelevanceTerm {A = A} {t = u} [Γ] [Γ] [A] [A]' [u]
      [Id] = Idᵗᵛ-min {A} {t} {u} [Γ] [A]' [t]' [u]'
  in maybeEmbTermᵛ {l = next l} {A = SProp _} {t = Id A t u} [Γ] (Uᵛgen (≡is≤ PE.refl) <next [Γ]) [Id]

Id-congᵛ-min : ∀ {A A' t t' u u' Γ l}
       ([Γ] : ⊩ᵛ Γ)
       ([A] : Γ ⊩ᵛ⟨ ι l ⟩ A ^ [ ! , ι l ] / [Γ])
       ([t] : Γ ⊩ᵛ⟨ ι l ⟩ t ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([u] : Γ ⊩ᵛ⟨ ι l ⟩ u ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([A'] : Γ ⊩ᵛ⟨ ι l ⟩ A' ^ [ ! , ι l ] / [Γ])
       ([t'] : Γ ⊩ᵛ⟨ ι l ⟩ t' ∷ A' ^ [ ! , ι l ] / [Γ] / [A'])
       ([u'] : Γ ⊩ᵛ⟨ ι l ⟩ u' ∷ A' ^ [ ! , ι l ] / [Γ] / [A'])
       ([A≡A'] : Γ ⊩ᵛ⟨ ι l ⟩ A ≡ A' ^ [ ! , ι l ] / [Γ] / [A])
       ([t≡t'] : Γ ⊩ᵛ⟨ ι l ⟩ t ≡ t' ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([u≡u'] : Γ ⊩ᵛ⟨ ι l ⟩ u ≡ u' ∷ A ^ [ ! , ι l ] / [Γ] / [A])
     → Γ ⊩ᵛ⟨ ι l ⟩ Id A t u ≡ Id A' t' u' ^ [ % , ι l ] / [Γ] / Idᵛ-min {A} {t} {u} [Γ] [A] [t] [u]
Id-congᵛ-min [Γ] [A] [t] [u] [A'] [t'] [u'] [A≡A'] [t≡t'] [u≡u'] ⊢Δ [σ] =
  [IdExt] ⊢Δ (proj₁ ([A] ⊢Δ [σ])) (proj₁ ([A'] ⊢Δ [σ])) ([A≡A'] ⊢Δ [σ])
             (proj₁ ([t] ⊢Δ [σ])) (proj₁ ([t'] ⊢Δ [σ])) ([t≡t'] ⊢Δ [σ])
             (proj₁ ([u] ⊢Δ [σ])) (proj₁ ([u'] ⊢Δ [σ])) ([u≡u'] ⊢Δ [σ])

Id-cong-minᵗᵛ : ∀ {A A' t t' u u' Γ l}
       ([Γ] : ⊩ᵛ Γ)
       ([A] : Γ ⊩ᵛ⟨ ι l ⟩ A ^ [ ! , ι l ] / [Γ])
       ([t] : Γ ⊩ᵛ⟨ ι l ⟩ t ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([u] : Γ ⊩ᵛ⟨ ι l ⟩ u ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([A'] : Γ ⊩ᵛ⟨ ι l ⟩ A' ^ [ ! , ι l ] / [Γ])
       ([t'] : Γ ⊩ᵛ⟨ ι l ⟩ t' ∷ A' ^ [ ! , ι l ] / [Γ] / [A'])
       ([u'] : Γ ⊩ᵛ⟨ ι l ⟩ u' ∷ A' ^ [ ! , ι l ] / [Γ] / [A'])
       ([A≡A'] : Γ ⊩ᵛ⟨ ι l ⟩ A ≡ A' ^ [ ! , ι l ] / [Γ] / [A])
       ([t≡t'] : Γ ⊩ᵛ⟨ ι l ⟩ t ≡ t' ∷ A ^ [ ! , ι l ] / [Γ] / [A])
       ([u≡u'] : Γ ⊩ᵛ⟨ ι l ⟩ u ≡ u' ∷ A ^ [ ! , ι l ] / [Γ] / [A])
     → Γ ⊩ᵛ⟨ next l ⟩ Id A t u ≡ Id A' t' u' ∷ SProp l ^ [ ! , next l ] / [Γ] / Uᵛgen (≡is≤ PE.refl) <next [Γ]
Id-cong-minᵗᵛ {A} {A'} {t} {t'} {u} {u'} [Γ] [A] [t] [u] [A'] [t'] [u'] [A≡A'] [t≡t'] [u≡u'] =
  let [U] = Uᵛgen (≡is≤ PE.refl) <next [Γ]
  in un-univEqᵛ {A = Id A t u} {B = Id A' t' u'} [Γ] [U]
                (Idᵛ-min {A} {t} {u} [Γ] [A] [t] [u])
                (Idᵛ-min {A'} {t'} {u'} [Γ] [A'] [t'] [u'])
                (Id-congᵛ-min {A} {A'} {t} {t'} {u} {u'} [Γ] [A] [t] [u] [A'] [t'] [u'] [A≡A'] [t≡t'] [u≡u'])

Id-congᵗᵛ : ∀ {A A' t t' u u' Γ l}
       ([Γ] : ⊩ᵛ Γ) →
       let [UA] = maybeEmbᵛ {A = U _} [Γ] (Uᵛ <next [Γ])
           [U] = maybeEmbᵛ {A = SProp _} [Γ] (Uᵛ <next [Γ])
       in ([A] : Γ ⊩ᵛ⟨ ∞ ⟩ A ^ [ ! , ι l ] / [Γ])
          ([t] : Γ ⊩ᵛ⟨ ∞ ⟩ t ∷ A ^ [ ! , ι l ] / [Γ] / [A])
          ([u] : Γ ⊩ᵛ⟨ ∞ ⟩ u ∷ A ^ [ ! , ι l ] / [Γ] / [A])
          ([A]t : Γ ⊩ᵛ⟨ ∞ ⟩ A ∷ Univ ! l ^ [ ! , next l ] / [Γ] / [UA])
          ([A'] : Γ ⊩ᵛ⟨ ∞ ⟩ A' ^ [ ! , ι l ] / [Γ])
          ([t'] : Γ ⊩ᵛ⟨ ∞ ⟩ t' ∷ A' ^ [ ! , ι l ] / [Γ] / [A'])
          ([u'] : Γ ⊩ᵛ⟨ ∞ ⟩ u' ∷ A' ^ [ ! , ι l ] / [Γ] / [A'])
          ([A']t : Γ ⊩ᵛ⟨ ∞ ⟩ A' ∷ Univ ! l ^ [ ! , next l ] / [Γ] / [UA])
          ([A≡A']t : Γ ⊩ᵛ⟨ ∞ ⟩ A ≡ A' ∷ Univ ! l ^ [ ! , next l ] / [Γ] / [UA])
          ([t≡t'] : Γ ⊩ᵛ⟨ ∞ ⟩ t ≡ t' ∷ A ^ [ ! , ι l ] / [Γ] / [A])
          ([u≡u'] : Γ ⊩ᵛ⟨ ∞ ⟩ u ≡ u' ∷ A ^ [ ! , ι l ] / [Γ] / [A])
          → Γ ⊩ᵛ⟨ ∞ ⟩ Id A t u ≡ Id A' t' u' ∷ SProp l ^ [ ! , next l ] / [Γ] / [U]
Id-congᵗᵛ {A} {A'} {t} {t'} {u} {u'} {_} {l} [Γ] [A] [t] [u] [A]t [A'] [t'] [u'] [A']t [A≡A']t [t≡t'] [u≡u'] =
   let [UA] = maybeEmbᵛ {A = U _} [Γ] (Uᵛ <next [Γ])
       [A]' = univᵛ {A = A} [Γ] (≡is≤ PE.refl) [UA] [A]t
       [t]' = S.irrelevanceTerm {A = A} {t = t} [Γ] [Γ] [A] [A]' [t]
       [u]' = S.irrelevanceTerm {A = A} {t = u} [Γ] [Γ] [A] [A]' [u]
       [A']' = univᵛ {A = A'} [Γ] (≡is≤ PE.refl) [UA] [A']t
       [t']' = S.irrelevanceTerm {A = A'} {t = t'} [Γ] [Γ] [A'] [A']' [t']
       [u']' = S.irrelevanceTerm {A = A'} {t = u'} [Γ] [Γ] [A'] [A']' [u']
       [A≡A']' = univEqᵛ {A = A} {B = A'} [Γ] [UA] [A]' [A≡A']t
       [t≡t']' = S.irrelevanceEqTerm {A = A} {t = t} {u = t'} [Γ] [Γ] [A] [A]' [t≡t']
       [u≡u']' = S.irrelevanceEqTerm {A = A} {t = u} {u = u'} [Γ] [Γ] [A] [A]' [u≡u']
       [Id] = Id-cong-minᵗᵛ {A} {A'} {t} {t'} {u} {u'} [Γ] [A]' [t]' [u]' [A']' [t']' [u']' [A≡A']' [t≡t']' [u≡u']'
   in maybeEmbEqTermᵛ {l = next l} {A = SProp _} {t = Id A t u} {u = Id A' t' u'} [Γ] (Uᵛgen (≡is≤ PE.refl) <next [Γ]) [Id]


module B where

open import A

B : Set
B = A


module _ where

import Imports.Issue1913-M as M

module _ where

  import Imports.Issue1913-I as I

  accepted₁ : M.D
  accepted₁ = I.x

! : ⦃ _ : M.D ⦄ → M.D
! ⦃ x ⦄ = x

accepted₂ : M.D
accepted₂ = !

-- rejected : M.D
-- rejected = I.x


module _ where

open import Agda.Builtin.List
open import Agda.Builtin.Reflection
open import Agda.Builtin.Unit

postulate
  A : Set

module _ (X : Set) where

  macro
    give : Name → Term → TC ⊤
    give x goal = unify (def x []) goal

  B : Set
  B = give A


-- Andreas, 2016-10-11, AIM XXIV, issue #2248
-- COMPILED_TYPE should only work on postulates

data Unit : Set where
  unit : Unit

abstract
  IO : Set → Set
  IO A = A

  doNothing : IO Unit
  doNothing = unit

{-# COMPILED_TYPE IO IO #-}

main : IO unit
main = doNothing


module Prelude.Erased where

data [erased]-is-only-for-printing : Set where
  [erased] : [erased]-is-only-for-printing


import Issue953

g : Set₁
g = Issue953.f


-- MIT License

-- Copyright (c) 2021 Luca Ciccone and Luca Padovani

-- Permission is hereby granted, free of charge, to any person
-- obtaining a copy of this software and associated documentation
-- files (the "Software"), to deal in the Software without
-- restriction, including without limitation the rights to use,
-- copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the
-- Software is furnished to do so, subject to the following
-- conditions:

-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-- OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-- HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
-- OTHER DEALINGS IN THE SOFTWARE.

{-# OPTIONS --guardedness --sized-types #-}

open import Data.Empty
open import Data.Product
open import Data.Sum
open import Data.List using ([]; _∷_; _∷ʳ_; _++_)

open import Relation.Nullary
open import Relation.Unary using (_∈_; _⊆_;_∉_)
open import Relation.Binary.PropositionalEquality using (_≡_; refl; subst; sym)
open import Relation.Binary.Construct.Closure.ReflexiveTransitive using (_◅◅_)

open import Function.Base using (case_of_)

open import Common

module Convergence {ℙ : Set} (message : Message ℙ)
  where

open import Trace message
open import SessionType message
open import Transitions message
open import HasTrace message
open import Session message
open import TraceInclusion message
open import Divergence message
open import FairCompliance message

PreConvergence : (SessionType -> SessionType -> Set) -> SessionType -> SessionType -> Set
PreConvergence rel T S =
  ∀{φ} (tφ : T HasTrace φ) (sφ : ¬ S HasTrace φ) ->
  ∃[ ψ ] ∃[ x ] (ψ ⊑ φ × ∃ λ (tψ : T HasTrace (ψ ∷ʳ O x)) ->
                         ∃ λ (sψ : S HasTrace (ψ ∷ʳ O x)) ->
                         rel (after tψ) (after sψ))

data _↓_ : SessionType -> SessionType -> Set where
  converge : ∀{T S} -> PreConvergence _↓_ T S -> T ↓ S

Convergence : SessionType -> SessionType -> Set
Convergence = PreConvergence _↓_

con-sound : ∀{T S} -> T ↓ S -> ConvergenceS T S
con-sound {T} {S} (converge C) {R} comp with fair-compliance->may-succeed comp
... | (R' # T') , reds , win#def w tdef with unzip-red* reds
... | φ , rr , tr with S HasTrace? φ
... | yes (S' , sdef , sr) = _ , zip-red* rr sr , win#def w sdef
... | no nsφ with C (_ , tdef , tr) nsφ
... | (ψ , x , prefix , tψx , sψx , con)
  with ⊑-has-co-trace prefix (_ , win->defined w , rr) | has-trace-snoc sψx
... | rψ | sψ@(_ , sdef , _) , _ with client-wins-or-accepts-prefix comp rψ tψx
... | inj₁ wψ = _ , zip-traces rψ sψ , win#def wψ sdef
... | inj₂ rψx with zip-traces rψx tψx
... | reds' with con-sound con (fair-compliance-red* comp reds')
... | (_ , reds'' , success) = _ , zip-traces rψx sψx ◅◅ reds'' , success

inclusion->convergence : ∀{T S} -> TraceInclusionS T S -> T ↓ S
inclusion->convergence sub = converge λ tφ nsφ -> ⊥-elim (nsφ (sub tφ))

not-convergence->exclusion : ∀{T S} -> ¬ T ↓ S -> ¬ TraceInclusionS T S
not-convergence->exclusion not sub = not (inclusion->convergence sub)

not-convergence+divergence : ∀{T S} -> T ↓ S -> T ↑ S -> ⊥
not-convergence+divergence (converge F) div =
  let φ = _↑_.trace div in
  let tφ = _↑_.with-trace div in
  let nsφ = _↑_.without-trace div in
  let _ , _ , pre , tψx , sψx , con' = F tφ nsφ in
  let div' = _↑_.divergence div pre tψx sψx in
  not-convergence+divergence con' div'

↓->preconv : ∀{S T} → S ↓ T → PreConvergence _↓_ S T
↓->preconv (converge x) = x

conv->defined : ∀{S T} → Defined S → S ↓ T → Defined T
conv->defined {_} {nil} inp (converge f) with f {[]} (inp _ , inp , refl) (λ x → not-nil-has-trace x)
... | _ , _ , none , _ , ht , _ = ⊥-elim (not-nil-has-trace ht)
conv->defined {_} {inp _} inp (converge _) = inp
conv->defined {_} {out _} inp (converge _) = out
conv->defined {_} {nil} out (converge f) with f {[]} (out _ , out , refl) (λ x → not-nil-has-trace x)
... | _ , _ , none , _ , ht , _ = ⊥-elim (not-nil-has-trace ht)
conv->defined {_} {inp _} out (converge _) = inp
conv->defined {_} {out _} out (converge _) = out

nil-converges : ∀{S} → nil ↓ S
nil-converges {S} = converge λ tφ _ → ⊥-elim (not-nil-has-trace tφ)

end-converges : ∀{T S} → End T → Defined S → T ↓ S
end-converges (inp e) def = converge λ tφ sφ →
  let eq = empty-inp-has-empty-trace e tφ in
  ⊥-elim (sφ (subst (λ ψ → _ HasTrace ψ) (sym eq) (_ , def , refl)))
end-converges (out e) def = converge λ tφ sφ →
  let eq = empty-out-has-empty-trace e tφ in
  ⊥-elim (sφ (subst (λ ψ → _ HasTrace ψ) (sym eq) (_ , def , refl)))

pre-conv-inp-back : ∀{f g}
  → (∀{x} → x ∈ dom f → PreConvergence _↓_ (f x .force) (g x .force))
  → PreConvergence _↓_ (inp f) (inp g)
pre-conv-inp-back _ {[]} _ no-tr = ⊥-elim (no-tr (_ , inp , refl))
pre-conv-inp-back {f} conv {I x ∷ tr} ok-tr no-tr with x ∈? f
pre-conv-inp-back {f} conv {I x ∷ tr} (_ , def , step inp red) no-tr | yes ok-x =
  let ϕ , α , (pref , (_ , d , r) , (_ , d' , r') , pr) = conv ok-x (_ , def , red) λ (_ , d , r) → no-tr (_ , d , step inp r) in
  I x ∷ ϕ , α , some pref , (_ , d , step inp r) , (_ , d' , step inp r') , pr
pre-conv-inp-back {f} conv {I x ∷ tr} ok-tr no-tr | no no-x = ⊥-elim (no-x (inp-hastrace->defined ok-tr))
pre-conv-inp-back _ {O _ ∷ _} (_ , _ , step () _) _


open import Data.Bool as Bool using (Bool; false; true; if_then_else_; not)
open import Data.String using (String)
open import Data.Nat using (ℕ; _+_; _≟_; suc; _>_; _<_; _∸_)
open import Relation.Nullary.Decidable using (⌊_⌋)
open import Data.List as l using (List; filter; map; take; foldl; length; []; _∷_)
open import Data.List.Properties
-- open import Data.List.Extrema using (max)
open import Data.Maybe using (to-witness)
open import Data.Fin using (fromℕ; _-_; zero; Fin)
open import Data.Fin.Properties using (≤-totalOrder)
open import Data.Product as Prod using (∃; ∃₂; _×_; _,_; Σ)
import Relation.Binary.PropositionalEquality as Eq
open Eq using (_≡_; refl; cong)
open Eq.≡-Reasoning
open import Level using (Level)
open import Data.Vec as v using (Vec; fromList; toList; last; length; []; _∷_; [_]; _∷ʳ_; _++_; lookup; head; initLast; filter; map)
open import Data.Vec.Bounded as vb using ([]; _∷_; fromVec; filter; Vec≤)
open import Relation.Binary.PropositionalEquality as P
  using (_≡_; _≢_; refl; _≗_; cong₂)
open import Data.Nat.Properties using (+-comm)
open import Relation.Unary using (Pred; Decidable)
open import Relation.Nullary using (does)
open import Data.Vec.Bounded.Base using (padRight; ≤-cast)
import Data.Nat.Properties as ℕₚ
open import Relation.Nullary.Decidable.Core using (dec-false)
open import Function using (_∘_)
open import Data.List.Extrema ℕₚ.≤-totalOrder

-- TODO add to std-lib
vecLast : ∀ {a} {A : Set a} {l} {n : ℕ} (xs : Vec A n) → last (xs ∷ʳ l) ≡ l
vecLast []       = refl
vecLast (_ ∷ xs) = P.trans (prop (xs ∷ʳ _)) (vecLast xs)
  where
    prop : ∀ {a} {A : Set a} {n x} (xs : Vec A (suc n)) → last (x v.∷ xs) ≡ last xs
    prop xs with initLast xs
    ...        | _ , _ , refl = refl

-- operations
  -- AddTodo
  -- DeleteTodo
  -- CompleteTodo
  -- ClearCompleted
  -- CompleteAllTodos

-- horizontal properties
  -- AddTodo
  --   non-commutative
  -- DeleteTodo
  --   idempotent
  -- CompleteTodo
  --   idempotent
  -- ClearCompleted
  --   idempotent
  -- CompleteAllTodos
  --   idempotent
  -- EditTodo
  --   EditTodo - EditTodo Todo list length doesn't change

-- vertical properties
  -- AddTodo
  --   AddTodoSetsNewCompletedToFalse
  --   AddTodoSetsNewIdToNonExistingId
  --   AddTodoSetsNewTextToText
  --   doesn't change id of other Todos
  --   doesn't change text of other Todos
  --   doesn't change completed of other Todos
  -- DeleteTodo
  --   DeleteTodoRemoveTodoWithId
  --   DeleteTodoRemoves1Element
  --     only way to add todo is with AddTodo and AddTodo gives non existing id to new todo
  --   doesn't change id of other Todos
  --   doesn't change text of other Todos
  --   doesn't change completed of other Todos
  -- CompleteTodo
  --   CompleteTodoSetsTodoWithIdCompletedToTrue
  --   doesn't touch any other Todo
  --   doesn't change id of any Todo
  --   doesn't change text of any Todo
  -- ClearCompleted
  --   doesn't remove Todos where completed = false
  --   doesn't change id of any Todo
  --   doesn't change completed of any Todo
  --   doesn't change text of any Todo
  -- CompleteAllTodos
  --   all Todos have completed = true
  --   doesn't change id of any Todo
  --   doesn't change text of any Todo
  -- EditTodo
  --   modifies Todo with given id's text
  --   doesn't change the id
  --   doesn't change completed
  --   doesn't modify other Todos

record Todo : Set where
  field
    text      : String
    completed : Bool
    id        : ℕ

AddTodo : ∀ {n : ℕ} → (Vec Todo n) → String → (Vec Todo (1 + n))
AddTodo todos text =
  todos ∷ʳ
  record
    { id        = 1 -- argmax (λ todo → λ e → e) todos) + 1
    ; completed = false
    ; text      = text
    }

ListAddTodo : List Todo → String → List Todo
ListAddTodo todos text =
  todos l.∷ʳ
  record
    { id        = (max 0 (l.map (λ e → Todo.id e) todos)) + 1
    ; completed = false
    ; text      = text
    }

ListAddTodoAddsNewListItem :
  (todos : List Todo) (text : String) →
    l.length (ListAddTodo todos text) ≡ l.length todos + 1
ListAddTodoAddsNewListItem todos text = length-++ todos

listVec : Vec ℕ 1
listVec = v.fromList (2 l.∷ l.[])

listLast : ℕ
listLast = v.last (v.fromList (2 l.∷ l.[]))

listLastIs2 : v.last (v.fromList (2 l.∷ l.[])) ≡ 2
listLastIs2 = refl

record Id : Set where
  field
    id : ℕ

natListToVec : (xs : List ℕ) → Vec ℕ (l.length xs)
natListToVec nats = v.fromList nats

-- natListLast : List ℕ → ℕ
-- natListLast nats = v.last {(l.length nats) ∸ 1} (v.fromList nats)

-- natListLast : List ℕ → ℕ
-- natListLast []            = 0
-- natListLast nats@(x ∷ xs) = v.last (v.fromList nats)

natListFromList : v.fromList (1 l.∷ l.[]) ≡ (1 v.∷ v.[])
natListFromList = refl

ListOf1sConcatFromList : v.fromList (1 l.∷ l.[] l.++ 1 l.∷ l.[]) ≡ (1 v.∷ v.[] v.++ 1 v.∷ v.[])
ListOf1sConcatFromList = refl

open import Data.Nat.Properties

{-# BUILTIN SIZE     Size   #-}
private
  variable
    a : Level
    A : Set a
    i : Size

vec-length-++ :
  ∀ {n : ℕ} (xs : Vec A n) {ys} →
    v.length (xs v.++ ys) ≡ v.length xs + v.length ys
vec-length-++ xs {ys} = refl

-- vec-fromList-++ :
--   (as bs : List A) →
--     v.fromList (as l.++ bs) ≡ v.fromList as v.++ v.fromList bs
-- vec-fromList-++ []       bs = v.[]
-- vec-fromList-++ (a ∷ as) bs = ?

-- natListConcatFromList : (nats1 : List ℕ) → (nats2 : List ℕ) → v.fromList (nats1 l.++ nats2) ≡ (nats1 v.++ nats2)
-- natListConcatFromList nats = ?

-- natListConcatFromList : (nats : List ℕ) → v.fromList (nats l.++ (1 l.∷ l.[])) ≡ ((v.fromList nats) v.++ (1 v.∷ v.[]))
-- natListConcatFromList = {!   !}

natListLast : List ℕ → ℕ
natListLast [] = 0
natListLast (x ∷ []) = x
natListLast (_ ∷ y ∷ l) = natListLast (y l.∷ l)

natListConcatLast : ∀ l → natListLast (l l.++ l.[ 1 ]) ≡ 1
natListConcatLast [] = refl
natListConcatLast (_ ∷ []) = refl
natListConcatLast (_ ∷ _ ∷ l) = natListConcatLast (_ l.∷ l)

TodoListConcatLast []          = refl
TodoListConcatLast (_ ∷ [])    = refl
TodoListConcatLast (_ ∷ _ ∷ l) = TodoListConcatLast (_ l.∷ l)

TodoListConcatLast : ∀ l → (TodoListLast (l l.++ l.[
  record
    { id        = 1
    ; completed = false
    ; text      = "text"
    }
 ])) ≡
  record
    { id        = 1
    ; completed = false
    ; text      = "text"
    }

TodoListConcatLastCompleted :
  ∀ l →
    Todo.completed (TodoListLast (l l.++ l.[
      record
        { id        = 1
        ; completed = false
        ; text      = "text"
        }
    ])) ≡ false
TodoListConcatLastCompleted []          = refl
TodoListConcatLastCompleted (_ ∷ [])    = refl
TodoListConcatLastCompleted (_ ∷ _ ∷ l) = TodoListConcatLastCompleted (_ l.∷ l)

-- _ : v.last (v.fromList (2 l.∷ l.[] l.++ 1 l.∷ l.[])) ≡ 1
-- _ = refl

-- natListConcatLast : (nats : List ℕ) → natListLast (nats l.++ 1 l.∷ l.[]) ≡ 1
-- natListConcatLast [] = refl
-- natListConcatLast nats@(x ∷ xs) =
--   begin
--     natListLast (nats l.++ 1 l.∷ l.[])
--   ≡⟨⟩
--     v.last (v.fromList ((x l.∷ xs) l.++ 1 l.∷ l.[]))
--   ≡⟨⟩
--     ?
--   ≡⟨⟩
--     1
--   ∎

-- TodoListLast : List Todo → Todo
-- TodoListLast []             = record {}
-- TodoListLast todos@(x ∷ xs) = v.last (v.fromList todos)

-- ListWith2ToVec : v.fromList (2 l.∷ l.[]) ≡ 2 v.∷ v.[]
-- ListWith2ToVec = refl

-- idListLastIdIs2 : Id.id (v.last (v.fromList (record {id = 2} l.∷ l.[]))) ≡ 2
-- idListLastIdIs2 = refl

-- todoListLastIdIs2 : Todo.id (v.last (v.fromList (record {id = 2; text = ""; completed = false} l.∷ l.[]))) ≡ 2
-- todoListLastIdIs2 = refl

-- ListTodoLastTextIsText :
--   (todos : List Todo) (text : String) →
--     Todo.text (v.last (v.fromList (
--       record
--       { text = text
--       ; completed = false
--       ; id = max 0 (l.map Todo.id todos) + 1
--       } l.∷ l.[]
--     ))) ≡ text
-- ListTodoLastTextIsText todos text = refl

-- -- ListAddTodoLastAddedElementIsTodo :
-- --   (todos : List Todo) (text : String) →
-- --     Todo.text (TodoListLast (ListAddTodo todos text)) ≡ text
-- -- ListAddTodoLastAddedElementIsTodo []       text = refl
-- -- ListAddTodoLastAddedElementIsTodo todos@(x ∷ xs) text =
-- --   begin
-- --     Todo.text (TodoListLast (ListAddTodo todos text))
-- --   ≡⟨⟩
-- --     Todo.text (
-- --       TodoListLast (
-- --         todos
-- --         l.++
-- --         (
-- --           record
-- --           { text = text
-- --           ; completed = false
-- --           ; id = max 0 (l.map Todo.id todos) + 1
-- --           }
-- --           l.∷
-- --           l.[]
-- --         )
-- --       )
-- --     )
-- --   ≡⟨⟩
-- --     Todo.text (
-- --       record
-- --       { text = text
-- --       ; completed = false
-- --       ; id = max 0 (l.map Todo.id todos) + 1
-- --       }
-- --     )
-- --   ≡⟨ ? ⟩
-- --     text
-- --   ∎

-- -- open import Data.Nat.Base

-- -- infixr 5 _vb∷ʳ_
-- -- _vb∷ʳ_ : ∀ {n} → Vec≤ A n → A → Vec≤ A (suc n)
-- -- (as , p) vb∷ʳ a = as , s≤s p v.∷ʳ a

-- -- Vec≤AddTodo : ∀ {n : ℕ} → (Vec≤ Todo n) → String → (Vec≤ Todo (1 + n))
-- -- Vec≤AddTodo todos text =
-- --   todos vb∷ʳ
-- --   record
-- --     { id        = 1 -- argmax (λ todo → λ e → e) todos) + 1
-- --     ; completed = false
-- --     ; text      = text
-- --     }

-- vecLength-++ :
--   ∀ {n m} (xs : Vec A n) {ys : Vec A m} →
--     v.length (xs ++ ys) ≡ v.length xs + v.length ys
-- vecLength-++ []       = refl
-- vecLength-++ (x ∷ xs) = cong suc (vecLength-++ xs)

-- AddTodoAddsNewListItem :
--   ∀ {n : ℕ} → (todos : Vec Todo n) (text : String) →
--     v.length (AddTodo todos text) ≡ v.length todos + 1
-- AddTodoAddsNewListItem []       text = refl
-- AddTodoAddsNewListItem (x v.∷ xs) text =
--   begin
--     v.length (AddTodo (x v.∷ xs) text)
--   ≡⟨⟩
--     1 + v.length (x v.∷ xs)
--   ≡⟨ +-comm 1 (v.length (x v.∷ xs))⟩
--     v.length (x v.∷ xs) + 1
--   ∎

-- ListTodoAddTodoAddsNewListItem :
--   (todos : List Todo) (text : String) →
--     l.length (ListAddTodo todos text) ≡ l.length todos + 1
-- ListTodoAddTodoAddsNewListItem []       text = refl
-- ListTodoAddTodoAddsNewListItem todos text =
--   +-comm 1 (l.length todos)

-- AddTodoLastAddedElementIsTodo :
--   ∀ {n} (todos : Vec Todo n) (text : String) →
--     last (AddTodo todos text) ≡
--       record
--         { id        = 1
--         ; completed = false
--         ; text      = text
--         }
-- AddTodoLastAddedElementIsTodo todos text = vecLast todos

-- -- should set (new element).completed to false
-- AddTodoSetsNewCompletedToFalse :
--   ∀ {n} (todos : Vec Todo n) (text : String) →
--     Todo.completed (last (AddTodo todos text)) ≡ false
-- AddTodoSetsNewCompletedToFalse todos text
--   rewrite
--     (AddTodoLastAddedElementIsTodo todos text) =
--       refl
-- -- should set (new element).id to an id not existing already in the list
-- AddTodoSetsNewIdTo1 :
--   ∀ {n} (todos : Vec Todo n) (text : String) →
--     Todo.id (last (AddTodo todos text)) ≡ 1
-- AddTodoSetsNewIdTo1 todos text
--   rewrite
--     (AddTodoLastAddedElementIsTodo todos text) =
--       refl
-- -- TODO should not touch other elements in the list

-- {-# COMPILE JS AddTodo =
--   function (todos) {
--     return function (text) {
--       return [
--         ...todos,
--         {
--           id: todos.reduce((maxId, todo) => Math.max(todo.id, maxId), -1) + 1,
--           completed: false,
--           text: text
--         }
--       ]
--     }
--   }
-- #-}

-- -- DeleteTodo : (List Todo) → ℕ → (List Todo)
-- -- DeleteTodo todos id' = filter (λ todo → Todo.id todo ≟ id') todos

-- open import Relation.Nullary

-- dec-¬ : ∀ {a} {P : Set a} → Dec P → Dec (¬ P)
-- dec-¬ (yes p) = no λ prf → prf p
-- dec-¬ (no ¬p) = yes ¬p

-- VecFilter : Vec≤.vec (v.filter (λ e → e ≟ 2) (2 v.∷ 1 v.∷ v.[])) ≡ (2 v.∷ v.[])
-- VecFilter = refl

-- -- VecFilter' : Vec≤.vec (v.filter (λ e → dec-¬ (e ≟ 2)) (2 v.∷ 1 v.∷ v.[])) ≡ (1 v.∷ v.[])
-- -- VecFilter' = refl

-- -- VecFilter'' : {n : ℕ} → Vec≤.vec (v.filter (λ e → e ≟ 2) (n v.∷ v.[])) ≡ 2 v.∷ v.[]
-- -- VecFilter'' = ?

-- -- VecFilter''' : {n : ℕ} → v.filter (λ e → e ≟ n) (n v.∷ v.[]) ≡ n vb.∷ vb.[]
-- -- VecFilter''' = {!   !}

-- -- ListFilter : l.filter (λ e → e ≟ 2) (2 l.∷ l.[]) ≡ 2 l.∷ l.[]
-- -- ListFilter = refl

-- -- ListFilter' : {n : ℕ} → l.filter (λ e → e ≟ n) (n l.∷ l.[]) ≡ n l.∷ l.[]
-- -- ListFilter' = {!   !}

-- -- DeleteNat : ∀ {n m} → (Vec ℕ n) → ℕ → (Vec ℕ m)
-- -- DeleteNat nats nat = Vec≤.vec (v.filter (λ e → e ≟ nat) nats)

-- DeleteNat : List ℕ → ℕ → List ℕ
-- DeleteNat nats nat = l.filter (λ e → dec-¬ (e ≟ nat)) nats

-- DeleteNat-idem :
--   (nats : List ℕ) →
--     (nat : ℕ) →
--       DeleteNat (DeleteNat nats nat) nat ≡ DeleteNat nats nat
-- DeleteNat-idem nats nat = filter-idem (λ e → dec-¬ (e ≟ nat)) nats
--   -- begin
--   --   DeleteNat (DeleteNat nats nat) nat
--   -- ≡⟨⟩
--   --   DeleteNat (l.filter (λ e → dec-¬ (e ≟ nat)) nats) nat
--   -- ≡⟨⟩
--   --   l.filter (λ e → dec-¬ (e ≟ nat)) (l.filter (λ e → dec-¬ (e ≟ nat)) nats)
--   -- ≡⟨⟩
--   --   (l.filter (λ e → dec-¬ (e ≟ nat)) ∘ l.filter (λ e → dec-¬ (e ≟ nat))) nats
--   -- ≡⟨ filter-idem (λ e → dec-¬ (e ≟ nat)) nats ⟩
--   --   l.filter (λ e → dec-¬ (e ≟ nat)) nats
--   -- ≡⟨⟩
--   --   DeleteNat nats nat
--   -- ∎

-- private
--   variable
--     p : Level

-- -- VecTodoDeleteTodo :
-- --   ∀ {n} →
-- --     (Vec Todo n)
-- --       → ℕ →
-- --         (Vec Todo n)
-- -- VecTodoDeleteTodo todos id' =
-- --   Vec≤.vec (v.filter (λ todo → dec-¬ (Todo.id todo ≟ id')) todos)

-- ListTodoDeleteTodo :
--   ∀ {n} →
--     (List Todo)
--       → ℕ →
--         (List Todo)
-- ListTodoDeleteTodo todos id' =
--   l.filter (λ todo → dec-¬ (Todo.id todo ≟ id')) todos

-- ListTodoDeleteTodo-idem :
--   (todos : List Todo) →
--     (id' : ℕ) →
--       ListTodoDeleteTodo (ListTodoDeleteTodo todos id') id' ≡ ListTodoDeleteTodo todos id'
-- ListTodoDeleteTodo-idem todos id' =
--   filter-idem (λ e → dec-¬ (Todo.id e ≟ id')) todos

-- -- Vec≤DeleteTodo : ∀ {n} → (Vec≤ Todo n) → ℕ → (Vec≤ Todo n)
-- -- Vec≤DeleteTodo todos id' = vb.filter (λ todo → Todo.id todo ≟ id') todos

DeleteNat : (List ℕ) → ℕ → (List ℕ)
DeleteNat nats id = filter' (λ n → not (n ≡ᵇ id)) nats

-- https://stackoverflow.com/questions/65622605/agda-std-lib-list-check-that-a-filtered-list-is-empty/65622709#65622709
DeleteNatRemoveNatWithId :
  (nats : List ℕ) (id : ℕ) →
    filter' (λ n → n ≡ᵇ id) (DeleteNat nats id) ≡ l.[]
DeleteNatRemoveNatWithId []       id         = refl
DeleteNatRemoveNatWithId (x ∷ xs) id with (x ≡ᵇ id) | inspect (_≡ᵇ id) x
... | true  | P.[ eq ] = DeleteNatRemoveNatWithId xs id
... | false | P.[ eq ] rewrite eq = DeleteNatRemoveNatWithId xs id

-- DONT WORK
-- DeleteNatRemoveNatWithId (x ∷ xs) id with x ≡ᵇ id | inspect (l._∷ (filter' (λ n → not (n ≡ᵇ id)) xs)) x
-- ... | true  | P.[ eq ] = DeleteNatRemoveNatWithId xs id
-- ... | false | P.[ eq ] rewrite eq = {!   !}
-- cong (x List.∷_) (DeleteNatRemoveNatWithId xs id)
  -- x List.∷ filter' (λ n → n ≡ᵇ id) (DeleteNat xs id) ≡ x List.∷ List.[]
-- cong (List._∷_) (DeleteNatRemoveNatWithId xs id)
  -- List._∷_ (filter' (λ n → n ≡ᵇ id) (DeleteNat xs id)) ≡ List._∷_ List.[]
-- cong₂ (List._∷_) refl (DeleteNatRemoveNatWithId xs id)
  -- _x_1193 List.∷ filter' (λ n → n ≡ᵇ id) (DeleteNat xs id) ≡ _x_1193 List.∷ List.[]
-- cong₂ (x List.∷_) refl (DeleteNatRemoveNatWithId xs id)
-- cong (filter' (λ n → n ≡ᵇ id) (x List.∷_)) (DeleteNatRemoveNatWithId xs id)
-- cong (filter' (λ n → n ≡ᵇ id)) (DeleteNatRemoveNatWithId xs id)
  -- filter' (λ n → n ≡ᵇ id) (filter' (λ n → n ≡ᵇ id) (DeleteNat xs id)) ≡ List.[]

-- DeleteTodo is well-defined
-- DeleteTodoRemoveTodoWithId :
--   (todos : List Todo) (id : ℕ) →
--     l.filter (λ todo → Todo.id todo ≟ id) (DeleteTodo todos id) ≡ l.[]
-- DeleteTodoRemoveTodoWithId []       id = refl
-- DeleteTodoRemoveTodoWithId (x ∷ xs) id with (Todo.id x ≟ id) | inspect (_≡ᵇ id) (Todo.id x)
-- ... | yes px  | P.[ eq ] = DeleteTodoRemoveTodoWithId xs id
-- ... | no  npx | P.[ eq ] rewrite eq = {!   !}

-- -- filterProof : v.filter (λ e → e ≟ 2) (2 v.∷ v.[]) ≡ (2 vb.∷ vb.[])
-- -- filterProof = refl

-- -- filterProof' : v.filter (λ e → dec-¬ (e ≟ 2)) (2 v.∷ v.[]) ≡ vb.[]
-- -- filterProof' = refl

-- -- dropWhileProof : v.dropWhile (λ e → e ≟ 2) (2 v.∷ 3 v.∷ v.[]) ≡ 3 vb.∷ vb.[]
-- -- dropWhileProof = refl

-- -- dropWhileProof' : v.dropWhile (λ e → e ≟ 3) (2 v.∷ 3 v.∷ v.[]) ≡ (2 vb.∷ 3 vb.∷ vb.[])
-- -- dropWhileProof' = refl

-- -- todoFilterProof :
-- --   v.filter
-- --     (λ todo → dec-¬ ((Todo.id todo) ≟ 2))
-- --     (
-- --       record
-- --         { id        = 2
-- --         ; completed = false
-- --         ; text      = ""
-- --         }
-- --       v.∷
-- --       record
-- --         { id        = 1
-- --         ; completed = false
-- --         ; text      = ""
-- --         }
-- --       v.∷
-- --       v.[]
-- --     )
-- --   ≡
-- --   (
-- --     record
-- --       { id        = 1
-- --       ; completed = false
-- --       ; text      = ""
-- --       }
-- --     vb.∷
-- --     vb.[]
-- --   )
-- -- todoFilterProof = refl

-- -- should remove element from the list unless there are no elements
-- -- should remove element with given id
-- -- DeleteTodoRemoveTodoById :
-- --   ∀ {n : ℕ} (id' : ℕ) (todos : Vec Todo n) →
-- --     padRight
-- --       record
-- --         { id        = 1 -- argmax (λ todo → λ e → e) todos) + 1
-- --         ; completed = false
-- --         ; text      = ""
-- --         }
-- --       (v.filter (λ todo → dec-¬ ((Todo.id todo) ≟ id')) (DeleteTodo todos id'))
-- --     ≡ DeleteTodo todos id'
-- -- DeleteTodoRemoveTodoById id' v.[] = refl
-- -- DeleteTodoRemoveTodoById id' (x v.∷ xs) = {!   !} (DeleteTodoRemoveTodoById xs)

-- -- {-# COMPILE JS DeleteTodo =
-- --   function (todos) {
-- --     return function (id) {
-- --       return todos.filter(function (todo) {
-- --         return todo.id !== id
-- --       });
-- --     }
-- --   }
-- -- #-}
-- -- EditTodo: can't use updateAt since id doesn't necessarily correspond to Vec index
-- VecTodoEditTodo : ∀ {n} → (Vec Todo n) → ℕ → String → (Vec Todo n)
-- VecTodoEditTodo todos id text =
--   v.map (λ todo →
--     if (⌊ Todo.id todo ≟ id ⌋)
--     then record todo { text = text }
--     else todo)
--     todos

-- ListTodoEditTodo : (List Todo) → ℕ → String → (List Todo)
-- ListTodoEditTodo todos id text =
--   l.map (λ todo →
--     if (⌊ Todo.id todo ≟ id ⌋)
--     then record todo { text = text }
--     else todo)
--     todos

-- ListTodoEditTodo-idem :
--   (todos : List Todo) →
--     (id' : ℕ) →
--       (text : String) →
--         ListTodoEditTodo (ListTodoEditTodo todos id' text) id' text ≡ ListTodoEditTodo todos id' text
-- ListTodoEditTodo-idem todos id' text =
--   begin
--     ListTodoEditTodo (ListTodoEditTodo todos id' text) id' text
--   ≡⟨ {!   !} ⟩
--     ListTodoEditTodo todos id' text
--   ∎

-- -- {-# COMPILE JS EditTodo =
-- --   function (todos) {
-- --     return function (id) {
-- --       return function (text) {
-- --         return todos.map(function (todo) {
-- --           if (todo.id === id) {
-- --             todo.text = text;
-- --           }

-- --           return todo;
-- --         });
-- --       }
-- --     }
-- --   }
-- -- #-}

-- VecTodoCompleteTodo : ∀ {n} → (Vec Todo n) → ℕ → (Vec Todo n)
-- VecTodoCompleteTodo todos id =
--   v.map (λ todo →
--     if (⌊ Todo.id todo ≟ id ⌋)
--     then record todo { completed = true }
--     else todo)
--     todos

-- ListTodoCompleteTodo : (List Todo) → ℕ → (List Todo)
-- ListTodoCompleteTodo todos id =
--   l.map (λ todo →
--     if (⌊ Todo.id todo ≟ id ⌋)
--     then record todo { completed = true }
--     else todo)
--     todos

-- ListTodoCompleteTodo-idem :
--   (todos : List Todo) →
--     (id' : ℕ) →
--       ListTodoCompleteTodo (ListTodoCompleteTodo todos id') id' ≡ ListTodoCompleteTodo todos id'
-- ListTodoCompleteTodo-idem todos id' =
--   begin
--     ListTodoCompleteTodo (ListTodoCompleteTodo todos id') id'
--   ≡⟨ {!   !} ⟩
--     ListTodoCompleteTodo todos id'
--   ∎

-- -- {-# COMPILE JS CompleteTodo =
-- --   function (todos) {
-- --     return function (id) {
-- --       return todos.map(function (todo) {
-- --         if (todo.id === id) {
-- --           todo.completed = true;
-- --         }

-- --         return todo;
-- --       });
-- --     }
-- --   }
-- -- #-}

-- CompleteAllTodos : ∀ {n} → (Vec Todo n) → (Vec Todo n)
-- CompleteAllTodos todos =
--   v.map (λ todo →
--     record todo { completed = true })
--     todos

-- ListTodoCompleteAllTodos : (List Todo) → (List Todo)
-- ListTodoCompleteAllTodos todos =
--   l.map (λ todo →
--     record todo { completed = true })
--     todos

-- ListTodoCompleteAllTodos-idem :
--   (todos : List Todo) →
--     ListTodoCompleteAllTodos (ListTodoCompleteAllTodos todos) ≡ ListTodoCompleteAllTodos todos
-- ListTodoCompleteAllTodos-idem todos = {!   !}

-- -- {-# COMPILE JS CompleteAllTodos =
-- --   function (todos) {
-- --     return todos.map(function(todo) {
-- --       todo.completed = true;
-- --       return todo;
-- --     });
-- --   }
-- -- #-}

-- VecTodoClearCompleted : ∀ {n} → (Vec Todo n) → (Vec Todo n)
-- VecTodoClearCompleted todos =
--   padRight
--     record
--       { id        = 1 -- argmax (λ todo → λ e → e) todos) + 1
--       ; completed = false
--       ; text      = ""
--       }
--     (v.filter (λ todo → dec-¬ ((Todo.completed todo) Bool.≟ true)) todos)

-- ListTodoClearCompleted : (List Todo) → (List Todo)
-- ListTodoClearCompleted todos =
--   (l.filter (λ todo → dec-¬ ((Todo.completed todo) Bool.≟ true)) todos)

-- ListTodoClearCompleted-idem :
--   (todos : List Todo) →
--       ListTodoClearCompleted (ListTodoClearCompleted todos) ≡ ListTodoClearCompleted todos
-- ListTodoClearCompleted-idem todos =
--   filter-idem (λ e → dec-¬ (Todo.completed e Bool.≟ true)) todos

-- -- should remove all elements where completed = true
-- -- should not change other elements
-- -- should not change (all elements).text
-- -- should not change (all elements).id

-- -- {-# COMPILE JS ClearCompleted =
-- --   function (todos) {
-- --     return todos.filter(function(todo) {
-- --       return !todo.completed;
-- --     });
-- --   }
-- -- #-}

-- -- add-todos-length-increased-by-1 : ∀ (todos : List Todo) → length (AddTodo todos "test")
-- -- add-todos-length-increased-by-1 = ?
-- -- delete-todos-length-decreased-by-1-except-if-length-0 : ()
-- -- edit-todos-length-not-changed : ()
-- -- complete-todos-length-not-changed : ()
-- -- complete-all-todos-length-not-changed : ()

-- -- clear-completed-todos-not-have-completed : ()

-- -- should not generate duplicate ids after CLEAR_COMPLETE

-- -- data Action : Set where
-- --   ADD_TODO DELETE_TODO EDIT_TODO COMPLETE_TODO COMPLETE_ALL_TODOS CLEAR_COMPLETED : Action

-- -- Reducer : Todos → Action → Todos
-- -- Reducer todos ADD_TODO = AddTodo todos id
-- -- Reducer todos DELETE_TODO = DeleteTodo todos id
-- -- Reducer todos EDIT_TODO = EditTodo todos id
-- -- Reducer todos COMPLETE_TODO = CompleteTodo todos id
-- -- Reducer todos COMPLETE_ALL_TODOS = CompleteAllTodos todos id
-- -- Reducer todos CLEAR_COMPLETED = ClearCompleted todos id


{-# OPTIONS --no-main #-}

data List (A : Set) : Set where
  [] : List A
  _∷_ : A → List A → List A

{-# COMPILE GHC List = data Non (Sense) #-} -- should result in warning when compiling
{-# BUILTIN LIST List #-}
{-# BUILTIN NIL  []   #-}
{-# BUILTIN CONS _∷_  #-}


-- The ATP pragma with the role <axiom> can be used with postulates.

module ATPAxiomPostulates where

postulate
  D    : Set
  zero : D
  succ : D → D
  N    : D → Set

postulate
  zN : N zero
  sN : ∀ {n} → N n → N (succ n)
{-# ATP axiom zN #-}


-- records are allowed in mutual blocks

module Issue138 where

mutual
  B = Set
  record Foo : Set where


------------------------------------------------------------------------
-- The Agda standard library
--
-- Some properties imply others
------------------------------------------------------------------------

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

module Relation.Binary.Consequences where

open import Relation.Binary.Core
open import Relation.Nullary using (yes; no)
open import Relation.Unary using (∁)
open import Function using (_∘_; flip)
open import Data.Maybe.Base using (just; nothing)
open import Data.Sum using (inj₁; inj₂)
open import Data.Product using (_,_)
open import Data.Empty using (⊥-elim)

------------------------------------------------------------------------
-- Substitutive properties

module _ {a ℓ p} {A : Set a} {_∼_ : Rel A ℓ} (P : Rel A p) where

  subst⟶respˡ : Substitutive _∼_ p → P Respectsˡ _∼_
  subst⟶respˡ subst {y} x'∼x Px'y = subst (flip P y) x'∼x Px'y

  subst⟶respʳ : Substitutive _∼_ p → P Respectsʳ _∼_
  subst⟶respʳ subst {x} y'∼y Pxy' = subst (P x) y'∼y Pxy'

  subst⟶resp₂ : Substitutive _∼_ p → P Respects₂ _∼_
  subst⟶resp₂ subst = subst⟶respʳ subst , subst⟶respˡ subst

module _ {a ℓ p} {A : Set a} {∼ : Rel A ℓ} {P : A → Set p} where

  P-resp⟶¬P-resp : Symmetric ∼ → P Respects ∼ → (∁ P) Respects ∼
  P-resp⟶¬P-resp sym resp x∼y ¬Px Py = ¬Px (resp (sym x∼y) Py)

------------------------------------------------------------------------
-- Proofs for non-strict orders

module _ {a ℓ₁ ℓ₂} {A : Set a} {_≈_ : Rel A ℓ₁} {_≤_ : Rel A ℓ₂} where

  total⟶refl : _≤_ Respects₂ _≈_ → Symmetric _≈_ →
                 Total _≤_ → _≈_ ⇒ _≤_
  total⟶refl (respʳ , respˡ) sym total {x} {y} x≈y with total x y
  ... | inj₁ x∼y = x∼y
  ... | inj₂ y∼x = respʳ x≈y (respˡ (sym x≈y) y∼x)

  total+dec⟶dec : _≈_ ⇒ _≤_ → Antisymmetric _≈_ _≤_ →
                    Total _≤_ → Decidable _≈_ → Decidable _≤_
  total+dec⟶dec refl antisym total _≟_ x y with total x y
  ... | inj₁ x≤y = yes x≤y
  ... | inj₂ y≤x with x ≟ y
  ...   | yes x≈y = yes (refl x≈y)
  ...   | no  x≉y = no (λ x≤y → x≉y (antisym x≤y y≤x))

------------------------------------------------------------------------
-- Proofs for strict orders

module _ {a ℓ₁ ℓ₂} {A : Set a} {_≈_ : Rel A ℓ₁} {_<_ : Rel A ℓ₂} where

  trans∧irr⟶asym : Reflexive _≈_ → Transitive _<_ →
                     Irreflexive _≈_ _<_ → Asymmetric _<_
  trans∧irr⟶asym refl trans irrefl x<y y<x =
    irrefl refl (trans x<y y<x)

  irr∧antisym⟶asym : Irreflexive _≈_ _<_ → Antisymmetric _≈_ _<_ →
                       Asymmetric _<_
  irr∧antisym⟶asym irrefl antisym x<y y<x =
    irrefl (antisym x<y y<x) x<y

  asym⟶antisym : Asymmetric _<_ → Antisymmetric _≈_ _<_
  asym⟶antisym asym x<y y<x = ⊥-elim (asym x<y y<x)

  asym⟶irr : _<_ Respects₂ _≈_ → Symmetric _≈_ →
               Asymmetric _<_ → Irreflexive _≈_ _<_
  asym⟶irr (respʳ , respˡ) sym asym {x} {y} x≈y x<y =
    asym x<y (respʳ (sym x≈y) (respˡ x≈y x<y))

  tri⟶asym : Trichotomous _≈_ _<_ → Asymmetric _<_
  tri⟶asym tri {x} {y} x<y x>y with tri x y
  ... | tri< _   _ x≯y = x≯y x>y
  ... | tri≈ _   _ x≯y = x≯y x>y
  ... | tri> x≮y _ _   = x≮y x<y

  tri⟶irr : Trichotomous _≈_ _<_ → Irreflexive _≈_ _<_
  tri⟶irr compare {x} {y} x≈y x<y with compare x y
  ... | tri< _   x≉y y≮x = x≉y x≈y
  ... | tri> x≮y x≉y y<x = x≉y x≈y
  ... | tri≈ x≮y _   y≮x = x≮y x<y

  tri⟶dec≈ : Trichotomous _≈_ _<_ → Decidable _≈_
  tri⟶dec≈ compare x y with compare x y
  ... | tri< _ x≉y _ = no  x≉y
  ... | tri≈ _ x≈y _ = yes x≈y
  ... | tri> _ x≉y _ = no  x≉y

  tri⟶dec< : Trichotomous _≈_ _<_ → Decidable _<_
  tri⟶dec< compare x y with compare x y
  ... | tri< x<y _ _ = yes x<y
  ... | tri≈ x≮y _ _ = no  x≮y
  ... | tri> x≮y _ _ = no  x≮y

  trans∧tri⟶respʳ≈ : Symmetric _≈_ → Transitive _≈_ →
                       Transitive _<_ → Trichotomous _≈_ _<_ →
                       _<_ Respectsʳ _≈_
  trans∧tri⟶respʳ≈ sym ≈-tr <-tr tri {x} {y} {z} y≈z x<y with tri x z
  ... | tri< x<z _ _ = x<z
  ... | tri≈ _ x≈z _ = ⊥-elim (tri⟶irr tri (≈-tr x≈z (sym y≈z)) x<y)
  ... | tri> _ _ z<x = ⊥-elim (tri⟶irr tri (sym y≈z) (<-tr z<x x<y))

  trans∧tri⟶respˡ≈ : Transitive _≈_ →
                       Transitive _<_ → Trichotomous _≈_ _<_ →
                       _<_ Respectsˡ _≈_
  trans∧tri⟶respˡ≈ ≈-tr <-tr tri {z} {_} {y} x≈y x<z with tri y z
  ... | tri< y<z _ _ = y<z
  ... | tri≈ _ y≈z _ = ⊥-elim (tri⟶irr tri (≈-tr x≈y y≈z) x<z)
  ... | tri> _ _ z<y = ⊥-elim (tri⟶irr tri x≈y (<-tr x<z z<y))

  trans∧tri⟶resp≈ : Symmetric _≈_ → Transitive _≈_ →
                      Transitive _<_ → Trichotomous _≈_ _<_ →
                      _<_ Respects₂ _≈_
  trans∧tri⟶resp≈ sym ≈-tr <-tr tri =
    trans∧tri⟶respʳ≈ sym ≈-tr <-tr tri ,
    trans∧tri⟶respˡ≈ ≈-tr <-tr tri

------------------------------------------------------------------------
-- Without Loss of Generality

module _ {a r q} {A : Set a} {_R_ : Rel A r} {Q : Rel A q} where

  wlog : Total _R_ → Symmetric Q →
         (∀ a b → a R b → Q a b) →
         ∀ a b → Q a b
  wlog r-total q-sym prf a b with r-total a b
  ... | inj₁ aRb = prf a b aRb
  ... | inj₂ bRa = q-sym (prf b a bRa)

------------------------------------------------------------------------
-- Other proofs

module _ {a b p} {A : Set a} {B : Set b} {P : REL A B p} where

  dec⟶weaklyDec : Decidable P → WeaklyDecidable P
  dec⟶weaklyDec dec x y with dec x y
  ... | yes p = just p
  ... | no _ = nothing

module _ {a b p q} {A : Set a} {B : Set b }
         {P : REL A B p} {Q : REL A B q}
         where

  map-NonEmpty : P ⇒ Q → NonEmpty P → NonEmpty Q
  map-NonEmpty f x = nonEmpty (f (NonEmpty.proof x))


module STLCRef.SemanticsLB where

-- This file contains a definitional interpreter for STLC+Ref as
-- described in Section 3 of the paper.  The interpreter operates with
-- the notion of monadic bind described in Section 3.3 of the paper;
-- see `Semantics.agda` for the version of the interpreter of STLC+Ref
-- using monadic strength as described in Section 3.4 of the paper.

open import Agda.Primitive
open import Data.Unit
open import Data.Nat hiding (_⊔_ ; _^_)
open import Data.Integer hiding (_⊔_)
open import Data.List
open import Data.Product
open import Data.Maybe hiding (_>>=_)
open import Data.List.Membership.Propositional
open import Data.List.Relation.Unary.All as All
open import Data.List.Relation.Unary.Any
open import Data.List.Prefix
open import Data.List.Properties.Extra
open import Data.List.All.Properties.Extra
open import Function
open import Common.Weakening

------------
-- SYNTAX --
------------

-- These definitions correspond to Section 3.1, except we have
-- included integers, integer operations, and a simple conditional
-- expression (if-zero) in the language.

data Ty : Set

Ctx = List Ty

data Ty where
  _⇒_  : (a b : Ty) → Ty
  unit : Ty
  int  : Ty
  ref  : Ty -> Ty

data Expr (Γ : List Ty) : Ty → Set where
  unit  : Expr Γ unit
  var   : ∀ {t} → t ∈ Γ → Expr Γ t
  ƛ     : ∀ {a b} → Expr (a ∷ Γ) b → Expr Γ (a ⇒ b)
  _·_   : ∀ {a b} → Expr Γ (a ⇒ b) → Expr Γ a → Expr Γ b
  num   : ℤ → Expr Γ int
  iop   : (ℤ → ℤ → ℤ) → (l r : Expr Γ int) → Expr Γ int
  ifz   : ∀ {t} → Expr Γ int → Expr Γ t → Expr Γ t → Expr Γ t
  ref   : ∀ {t} → Expr Γ t → Expr Γ (ref t)
  !_    : ∀ {t} → Expr Γ (ref t) → Expr Γ t
  _≔_   : ∀ {t} → Expr Γ (ref t) → Expr Γ t → Expr Γ unit

-----------------------
-- STORES AND VALUES --
-----------------------

StoreTy = List Ty

-- `Val` uses `_∈_` from `Relation.Binary` in the Agda Standard
-- Library to represent typed locations which witness the existence of
-- a store location in the store type.

mutual
  data Val : Ty → (Σ : StoreTy) → Set where
    loc    : ∀ {Σ t} → t ∈ Σ → Val (ref t) Σ
    unit   : ∀ {Σ} → Val unit Σ
    ⟨_,_⟩  : ∀ {Σ Γ a b} → Expr (a ∷ Γ) b → Env Γ Σ → Val (a ⇒ b) Σ
    num   : ∀ {Σ} → ℤ → Val int Σ

  Env : (Γ : Ctx)(Σ : StoreTy) → Set
  Env Γ Σ = All (λ t → Val t Σ) Γ

Store : (Σ : StoreTy) → Set
Store Σ = All (λ t → Val t Σ) Σ

-- The `lookup-store` function is defined in terms of the `lookup`
-- function from `Data.List.All` in the Agda Standard Library.
lookup-store : ∀ {Σ t} → t ∈ Σ → Store Σ → Val t Σ
lookup-store x μ = All.lookup μ x

-- The `update-store` function is defined in terms of the update
-- function for the `All` type: `_All[_]≔'_` from the Standard Library
-- extension (contained in the `lib/*` folder of this artifact).
update-store : ∀ {Σ t} → t ∈ Σ → Val t Σ → Store Σ → Store Σ
update-store ptr v μ = μ All.[ ptr ]≔ v

-----------
-- MONAD --
-----------

-- These definitions correspond to Section 3.3.

M : ∀ {i}(Γ : Ctx) → (p : StoreTy → Set i) → (Σ : StoreTy) → Set i
M Γ p Σ = Env Γ Σ → Store Σ → Maybe (∃ λ Σ' → Store Σ' × p Σ' × Σ ⊑ Σ')

mutual
  weaken-val  : ∀ {a}{Σ Σ' : StoreTy} → Σ ⊑ Σ' → Val a Σ → Val a Σ'
  weaken-val ext unit      = unit
  weaken-val ext (loc l)   = loc (∈-⊒ l ext)
  weaken-val ext ⟨ e , E ⟩ = ⟨ e , weaken-env ext E ⟩
  weaken-val ext (num z)   = num z

  weaken-env  : ∀ {Γ}{Σ Σ' : StoreTy} → Σ ⊑ Σ' → Env Γ Σ → Env Γ Σ'
  weaken-env ext (v ∷ vs)  = weaken-val ext v ∷ weaken-env ext vs
  weaken-env ext []        = []

return   :    ∀ {Σ Γ}{p : List Ty → Set} → p Σ → M Γ p Σ
return x E μ = just (_ , μ , x , ⊑-refl)

_>>=_ : ∀ {Σ Γ}{p q : StoreTy → Set} →
        (f : M Γ p Σ) → (g : ∀ {Σ'} → Σ ⊑ Σ' → p Σ' → M Γ q Σ') → M Γ q Σ
(f >>= c) E μ = case (f E μ) of λ{
  nothing → nothing ;
  (just (_ , μ' , x , ext)) → case (c ext x (weaken-env ext E) μ') of λ{
    nothing → nothing ;
    (just (_ , μ'' , y , ext')) → just (_ , μ'' , y , ext ⊚ ext')
  }}

getEnv  : ∀ {Σ Γ} → M Γ (Env Γ) Σ
getEnv E = return E E

usingEnv : ∀ {Σ Γ Γ'}{p : List Ty → Set} → Env Γ Σ → M Γ p Σ → M Γ' p Σ
usingEnv E f  _ = f E

timeout : ∀ {Σ Γ}{p : List Ty → Set} → M Γ p Σ
timeout _ _ = nothing

store : ∀ {Σ t Γ} → Val t Σ → M Γ (Val (ref t)) Σ
store {Σ} {t} v _ μ
  = let ext = ∷ʳ-⊒ t Σ
        v'  = loc (∈-∷ʳ Σ t)
        μ'  = (All.map (weaken-val ext) μ) all-∷ʳ (weaken-val ext v)
    in just (_ , μ' , v' , ext)

deref : ∀ {Σ Γ t} → t ∈ Σ → M Γ (Val t) Σ
deref x E μ = return (All.lookup μ x) E μ

update : ∀ {Σ Γ t} → t ∈ Σ → Val t Σ → M Γ (λ _ → ⊤) Σ
update x v E μ = return tt E (update-store x v μ)

eval : ℕ → ∀ {Σ Γ t} → Expr Γ t → M Γ (Val t) Σ
eval zero    _           =
  timeout
eval (suc k) unit        =
  return unit
eval (suc k) (var x)     =
  getEnv >>= λ _ E →
  return (All.lookup E x)
eval (suc k) (ƛ e)       =
  getEnv >>= λ _ E →
  return ⟨ e , E ⟩
eval (suc k) (l · r)     =
  eval k l >>= λ{ ext ⟨ e , E ⟩ →
  eval k r >>= λ ext' v →
  usingEnv (v ∷ weaken-env ext' E) (eval k e) }  -- explicit weakening
eval (suc k) (num x)     =
  return (num x)
eval (suc k) (iop f l r) =
  eval k l >>= λ{ _ (num v) →
  eval k r >>= λ{ _ (num vᵣ) →
  return (num (f v vᵣ)) }}
eval (suc k) (ifz c t e) =
  eval k c >>= λ{ _ (num z) →
  case z of λ{ (+ zero) →
    eval k t
  ; _ →
    eval k e }}
eval (suc k) (ref e)     =
  eval k e >>= λ _ v →
  store v
eval (suc k) (! e)       =
  eval k e >>= λ{ _ (loc l) →
  deref l }
eval (suc k) (r ≔ e)     =
  eval k r >>= λ{ _ (loc l) →
  eval k e >>= λ ext v →
  update (∈-⊒ l ext) v >>= λ _ _ →             -- explicit weakening
  return unit }


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

NaN : Float
NaN = primFloatDiv 0.0 0.0

defNaN : NaN ≡ NaN
defNaN = refl

primEqNaN : primFloatEquality NaN NaN ≡ true
primEqNaN = refl


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

open import HoTT
open import homotopy.Bouquet
open import homotopy.FinWedge
open import homotopy.SphereEndomorphism
open import groups.SphereEndomorphism
open import cw.CW
open import cw.FinCW
open import cw.WedgeOfCells
open import cw.DegreeByProjection {lzero}
open import cohomology.Theory

{- This file should be part of RephraseHigherFinCoboundary,
   but putting these in a separate file seems more effective
   in speeding up type-checking. Could be an Agda bug. -}

module cw.cohomology.cochainequiv.HigherCoboundaryAbstractDefs (OT : OrdinaryTheory lzero)
  {n} (⊙fin-skel : ⊙FinSkeleton (S (S n))) where

open OrdinaryTheory OT
open import cohomology.Bouquet OT

private
  ⊙skel = ⊙FinSkeleton-realize ⊙fin-skel
  fin-skel = ⊙FinSkeleton.skel ⊙fin-skel
  I = AttachedFinSkeleton.numCells fin-skel
  skel = ⊙Skeleton.skel ⊙skel
  dec = ⊙FinSkeleton-has-cells-with-dec-eq ⊙fin-skel

  ⊙fin-skel₋₁ = ⊙fcw-init ⊙fin-skel
  ⊙skel₋₁ = ⊙FinSkeleton-realize ⊙fin-skel₋₁
  fin-skel₋₁ = ⊙FinSkeleton.skel ⊙fin-skel₋₁
  I₋₁ = AttachedFinSkeleton.numCells fin-skel₋₁
  skel₋₁ = ⊙Skeleton.skel ⊙skel₋₁
  dec₋₁ = ⊙FinSkeleton-has-cells-with-dec-eq ⊙fin-skel₋₁

open import cw.cohomology.WedgeOfCells OT
open import cw.cohomology.reconstructed.HigherCoboundary OT ⊙skel

⊙function₀ : ⊙FinBouquet I (S (S n)) ⊙→ ⊙Susp (⊙FinBouquet I₋₁ (S n))
⊙function₀ = ⊙Susp-fmap (⊙<– (Bouquet-⊙equiv-Xₙ/Xₙ₋₁ skel₋₁))
          ⊙∘ ⊙cw-∂-before-Susp
          ⊙∘ ⊙–> (Bouquet-⊙equiv-Xₙ/Xₙ₋₁ skel)

function₁ : Fin I → Fin I₋₁ → Sphere-endo (S n)
function₁ <I <I₋₁ = bwproj Fin-has-dec-eq <I₋₁
                  ∘ <– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁)
                  ∘ cfcod
                  ∘ attaching-last skel <I

abstract
  ⊙function₀' : ⊙FinBouquet I (S (S n)) ⊙→ ⊙Susp (⊙FinBouquet I₋₁ (S n))
  ⊙function₀' = ⊙function₀

  ⊙function₀'-β : ⊙function₀' == ⊙function₀
  ⊙function₀'-β = idp

  function₁' : Fin I → Fin I₋₁ → Sphere-endo (S n)
  function₁' = function₁

  function₁'-β : ∀ <I <I₋₁ → function₁' <I <I₋₁ == function₁ <I <I₋₁
  function₁'-β _ _ = idp

  mega-reduction : ∀ <I <I₋₁ →
      Susp-fmap (fwproj <I₋₁) ∘ fst ⊙function₀' ∘ fwin <I
    ∼ Susp-fmap (function₁' <I <I₋₁)
  mega-reduction <I <I₋₁ = Susp-elim idp idp λ x → ↓-='-in' $ ! $
    ap (Susp-fmap (fwproj <I₋₁) ∘ fst ⊙function₀ ∘ fwin <I) (merid x)
      =⟨ ap-∘
          ( Susp-fmap (fwproj <I₋₁)
          ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁))
          ∘ cw-∂-before-Susp)
          (Bouquet-to-Xₙ/Xₙ₋₁ skel ∘ fwin <I)
          (merid x) ⟩
    ap ( Susp-fmap (fwproj <I₋₁)
       ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁))
       ∘ cw-∂-before-Susp)
       (ap (Bouquet-to-Xₙ/Xₙ₋₁ skel ∘ fwin <I) (merid x))
      =⟨ ap (ap ( Susp-fmap (fwproj <I₋₁)
                ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁))
                ∘ cw-∂-before-Susp))
            (Bouquet-to-Xₙ/Xₙ₋₁-in-merid-β skel <I x) ⟩
    ap ( Susp-fmap (fwproj <I₋₁)
       ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁))
       ∘ cw-∂-before-Susp)
       (cfglue (attaching-last skel <I x) ∙' ap cfcod (spoke <I x))
      =⟨ ap-∘
          ( Susp-fmap (fwproj <I₋₁)
          ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁)))
          cw-∂-before-Susp
          (cfglue (attaching-last skel <I x) ∙' ap cfcod (spoke <I x)) ⟩
    ap ( Susp-fmap (fwproj <I₋₁)
       ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁)))
       (ap cw-∂-before-Susp
         (cfglue (attaching-last skel <I x) ∙' ap cfcod (spoke <I x)))
      =⟨ ap (ap ( Susp-fmap (fwproj <I₋₁)
                ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁))))
            ( ap-∙' cw-∂-before-Susp (cfglue (attaching-last skel <I x)) (ap cfcod (spoke <I x))
            ∙ ap2 _∙'_
                (cw-∂-before-Susp-glue-β (attaching-last skel <I x))
                ( ∘-ap cw-∂-before-Susp cfcod (spoke <I x)
                ∙ ap-cst south (spoke <I x))) ⟩
    ap ( Susp-fmap (fwproj <I₋₁)
       ∘ Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁)))
       (merid (cfcod (attaching-last skel <I x)))
      =⟨ ap-∘
          (Susp-fmap (fwproj <I₋₁))
          (Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁)))
          (merid (cfcod (attaching-last skel <I x))) ⟩
    ap (Susp-fmap (fwproj <I₋₁))
       (ap (Susp-fmap (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁)))
           (merid (cfcod (attaching-last skel <I x))))
      =⟨ ap
          (ap (Susp-fmap (fwproj <I₋₁)))
          (SuspFmap.merid-β
            (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁))
            (cfcod (attaching-last skel <I x))) ⟩
    ap (Susp-fmap (fwproj <I₋₁))
       (merid (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁) (cfcod (attaching-last skel <I x))))
      =⟨ SuspFmap.merid-β (fwproj <I₋₁)
          (<– (Bouquet-equiv-Xₙ/Xₙ₋₁ skel₋₁) (cfcod (attaching-last skel <I x))) ⟩
    merid (function₁ <I <I₋₁ x)
      =⟨ ! $ SuspFmap.merid-β (function₁ <I <I₋₁) x ⟩
    ap (Susp-fmap (function₁ <I <I₋₁)) (merid x)
      =∎


module examplesPaperJFP.Console where

open import  examplesPaperJFP.NativeIOSafe
open import  examplesPaperJFP.BasicIO hiding (main)
open import  examplesPaperJFP.ConsoleInterface public

IOConsole : Set → Set
IOConsole = IO ConsoleInterface

--IOConsole+ : Set → Set
--IOConsole+ = IO+ ConsoleInterface

translateIOConsoleLocal : (c : ConsoleCommand) → NativeIO (ConsoleResponse c)
translateIOConsoleLocal (putStrLn s)  =  nativePutStrLn s
translateIOConsoleLocal getLine       =  nativeGetLine

translateIOConsole : {A : Set} → IOConsole A → NativeIO A
translateIOConsole = translateIO translateIOConsoleLocal

main : NativeIO Unit
main = nativePutStrLn "Console"


{-# OPTIONS --cubical-compatible #-}
module _ where

infix 4 _≡_
data _≡_ {a} {A : Set a} (x : A) : A → Set a where
  instance refl : x ≡ x

{-# BUILTIN EQUALITY _≡_ #-}
{-# BUILTIN REFL refl #-}  -- This should trigger a warning!


{-# OPTIONS --safe #-}

open import Definition.Typed.EqualityRelation

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

open import Definition.Untyped
open import Definition.Typed
open import Definition.Typed.Properties
open import Definition.LogicalRelation
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Substitution
open import Definition.LogicalRelation.Substitution.Introductions.Universe
open import Definition.LogicalRelation.Substitution.Introductions.Pi
open import Definition.LogicalRelation.Substitution.MaybeEmbed

open import Tools.Unit as TU
open import Tools.Product
import Tools.PropositionalEquality as PE

-- Validity of the Empty type.
Emptyᵛ : ∀ {Γ ll l} ([Γ] : ⊩ᵛ Γ) → Γ ⊩ᵛ⟨ l ⟩ Empty ll ^ [ % , ι ll ] / [Γ]
Emptyᵛ [Γ] ⊢Δ [σ] = Emptyᵣ (idRed:*: (univ (Emptyⱼ ⊢Δ))) , λ _ x₂ → id (univ (Emptyⱼ ⊢Δ))

-- Validity of the Empty type as a term.
Emptyᵗᵛ : ∀ {Γ l ll} ([Γ] : ⊩ᵛ Γ) → (l< : ι ll <∞ l)
    → Γ ⊩ᵛ⟨ l ⟩ Empty ll ∷ Univ % ll ^ [ ! , next ll ]  / [Γ] / Uᵛ l< [Γ]
Emptyᵗᵛ {ll = ll} [Γ] emb< ⊢Δ [σ] = let ⊢Empty  = Emptyⱼ ⊢Δ
                       in  Uₜ (Empty ll) (idRedTerm:*: ⊢Empty) Emptyₙ (≅ₜ-Emptyrefl ⊢Δ) (λ x ⊢Δ' → Emptyᵣ (idRed:*: (univ (Emptyⱼ ⊢Δ'))))
                           , λ x x₁ → Uₜ₌ -- Empty Empty (idRedTerm:*: ⊢Empty) (idRedTerm:*: ⊢Empty) Emptyₙ Emptyₙ
                                   (Uₜ (Empty ll) (idRedTerm:*: ⊢Empty) Emptyₙ (≅ₜ-Emptyrefl ⊢Δ) (λ x₂ ⊢Δ' → Emptyᵣ (idRed:*: (univ (Emptyⱼ ⊢Δ')))))
                                   (Uₜ (Empty ll) (idRedTerm:*: ⊢Empty) Emptyₙ (≅ₜ-Emptyrefl ⊢Δ) (λ x₂ ⊢Δ' → Emptyᵣ (idRed:*: (univ (Emptyⱼ ⊢Δ')))))
                                   (≅ₜ-Emptyrefl ⊢Δ) λ [ρ] ⊢Δ' → id (univ (Emptyⱼ ⊢Δ'))
Emptyᵗᵛ {ll = ll} [Γ] ∞< ⊢Δ [σ] = let ⊢Empty  = Emptyⱼ ⊢Δ
                       in  Uₜ (Empty ll) (idRedTerm:*: ⊢Empty) Emptyₙ (≅ₜ-Emptyrefl ⊢Δ) (λ x ⊢Δ' → Emptyᵣ (idRed:*: (univ (Emptyⱼ ⊢Δ'))))
                           , λ x x₁ → Uₜ₌ -- Empty Empty (idRedTerm:*: ⊢Empty) (idRedTerm:*: ⊢Empty) Emptyₙ Emptyₙ
                                   (Uₜ (Empty ll) (idRedTerm:*: ⊢Empty) Emptyₙ (≅ₜ-Emptyrefl ⊢Δ) (λ x₂ ⊢Δ' → Emptyᵣ (idRed:*: (univ (Emptyⱼ ⊢Δ')))))
                                   (Uₜ (Empty ll) (idRedTerm:*: ⊢Empty) Emptyₙ (≅ₜ-Emptyrefl ⊢Δ) (λ x₂ ⊢Δ' → Emptyᵣ (idRed:*: (univ (Emptyⱼ ⊢Δ')))))
                                   (≅ₜ-Emptyrefl ⊢Δ) λ [ρ] ⊢Δ' → id (univ (Emptyⱼ ⊢Δ'))

Unitᵗᵛ : ∀ {Γ l} ([Γ] : ⊩ᵛ Γ) → Γ ⊩ᵛ⟨ ∞ ⟩ Unit ∷ (SProp l) ^ [ ! , next l ] / [Γ] / maybeEmbᵛ {A = SProp l} [Γ] (Uᵛ (proj₂ (levelBounded _)) [Γ])
Unitᵗᵛ {Γ} {l} [Γ] = let [SProp] = maybeEmbᵛ {A = SProp l} [Γ] (Uᵛ {rU = %} (proj₂ (levelBounded _)) [Γ])
                         [Empty] = Emptyᵛ {ll = l} {l = ∞} [Γ]
                         [Γ∙Empty] = (_∙_ {Γ} {Empty l} [Γ] [Empty])
                         [SProp]₁ : Γ ∙ Empty l ^ [ % , ι l ] ⊩ᵛ⟨ ∞ ⟩ (SProp l) ^ [ ! , next l ] / [Γ∙Empty]
                         [SProp]₁ {Δ} {σ} = maybeEmbᵛ {A = SProp l} [Γ∙Empty] (λ {Δ} {σ} → Uᵛ (proj₂ (levelBounded _)) [Γ∙Empty] {Δ} {σ}) {Δ} {σ}
                         [Empty]₁ = maybeEmbTermᵛ {A = SProp l} {t = Empty l} [Γ] (Uᵛ {rU = %} (proj₂ (levelBounded _)) [Γ]) (Emptyᵗᵛ {ll = l} [Γ] (proj₂ (levelBounded _)))
                         [Empty]₂ = maybeEmbTermᵛ {A = SProp l} {t = Empty l} [Γ∙Empty] (λ {Δ} {σ} → Uᵛ (proj₂ (levelBounded _)) [Γ∙Empty] {Δ} {σ}) (Emptyᵗᵛ {ll = l} [Γ∙Empty] (proj₂ (levelBounded _)))
                in maybeEmbTermᵛ {A = SProp l} {t = Unit} [Γ] [SProp]
                                 (Πᵗᵛ {Empty l} {Empty l} (≡is≤ PE.refl) (≡is≤ PE.refl) [Γ] ( Emptyᵛ {ll = l} [Γ]) (λ {Δ} {σ} → [SProp]₁ {Δ} {σ}) [Empty]₁ (λ {Δ} {σ} → [Empty]₂ {Δ} {σ}))

Unit≡Unit : ∀ {Γ l} (⊢Γ : ⊢ Γ)
          → Γ ⊢ Unit {l} ≅ Unit {l} ∷ SProp l ^ [ ! , next l ]
Unit≡Unit ⊢Γ = ≅ₜ-Π-cong (≡is≤ PE.refl) (≡is≤ PE.refl) (univ (Emptyⱼ ⊢Γ)) (≅ₜ-Emptyrefl ⊢Γ) (≅ₜ-Emptyrefl (⊢Γ ∙ univ (Emptyⱼ ⊢Γ)))

Unitᵛ : ∀ {Γ l} ([Γ] : ⊩ᵛ Γ) → Γ ⊩ᵛ⟨ ι l ⟩ Unit ^ [ % , ι l ] / [Γ]
Unitᵛ {Γ} {l} [Γ] = univᵛ {A = Unit} [Γ] (≡is≤ PE.refl) (maybeEmbᵛ {A = SProp l} [Γ] (Uᵛ {rU = %} (proj₂ (levelBounded _)) [Γ])) (Unitᵗᵛ {l = l} [Γ])

UnitType : ∀ {Γ l} (⊢Γ : ⊢ Γ) → Γ ⊩⟨ ι l ⟩ Unit ^ [ % , ι l ]
UnitType {Γ} ⊢Γ = proj₁ (Unitᵛ ε {Γ} {idSubst} ⊢Γ TU.tt)

EmptyType : ∀ {Γ l} (⊢Γ : ⊢ Γ) → Γ ⊩⟨ ι l ⟩ Empty l ^ [ % , ι l ]
EmptyType {Γ} ⊢Γ = proj₁ (Emptyᵛ ε {Γ} {idSubst} ⊢Γ TU.tt)


module ModuleMacro where

record ⊤
  : Set
  where

module M where

module N where

  postulate

    A
      : Set

    B
      : Set

module O
  = M

module P
  = M

module Q
  = P

module R
  (x : ⊤)
  = N
  using (A)

module S
  = N
  renaming
  ( A
    to A'
  ; B
    to B'
  )

y
  : ⊤
y
  = record {O}

C
  : ⊤
  → Set
C
  = R.A

D
  : Set
D
  = S.B'


-- Andreas, 2022-03-28, issue #5856, reported by Szumi Xie.
-- Patterns in path-lambdas were simply ignored, but should be illegal.

{-# OPTIONS --cubical #-}

open import Agda.Builtin.Cubical.Path

postulate
  A E : Set
  a : A

data C : Set where
  c : E → C

p : a ≡ a
p = λ (c e) → e

-- WAS: panic about unbound identifier e.

-- Expected error:
-- Patterns are not allowed in Path-lambdas
-- when checking that the expression λ .patternInTele0 @ (c e) → e has type a ≡ a


------------------------------------------------------------------------
-- The Agda standard library
--
-- Examples of pretty printing
------------------------------------------------------------------------

module README.Text.Pretty where

open import Size

open import Data.Bool.Base
open import Data.List.Base as List
open import Data.List.NonEmpty as List⁺
open import Data.Nat.Base
open import Data.Product
open import Data.String.Base hiding (parens; _<+>_)
open import Data.Vec.Base as Vec
open import Function.Base

-- We import the pretty printer and pass 80 to say that we do not want to
-- have lines longer than 80 characters
open import Text.Pretty 80

open import Relation.Binary.PropositionalEquality

------------------------------------------------------------------------
-- A small declarative programming language
------------------------------------------------------------------------

-- We define a small programming language where definitions are
-- introduced by providing a non-empty list of equations with:
-- * the same number of patterns on the LHS
-- * a term on the RHS of each equation

-- A pattern is either a variable or a constructor applied to a
-- list of subpatterns

data Pattern (i : Size) : Set where
  var : String → Pattern i
  con : ∀ {j : Size< i} → String → List (Pattern j) → Pattern i

-- A term is either a (bound) variable, the application of a
-- named definition / constructor to a list of arguments or a
-- lambda abstraction

data Term (i : Size) : Set where
  var : String → Term i
  app : ∀ {j : Size< i} → String → List (Term j) → Term i
  lam : ∀ {j : Size< i} → String → Term j → Term i

-- As explained before, a definitions is given by a list of equations

infix 1 _by_
record Def : Set where
  constructor _by_
  field name      : String
        {arity}   : ℕ
        equations : List⁺ (Vec (Pattern _) arity × (Term _))

------------------------------------------------------------------------
-- A pretty printer for this language
------------------------------------------------------------------------

-- First we print patterns. We only wrap a pattern in parentheses if it
-- is compound: i.e. if it is a constructor applied to a non-empty list
-- of subpatterns
-- Lists of patterns are printed separated by a single space.

prettyPattern  : ∀ {i} → Pattern i → Doc
prettyPatterns : ∀ {i} → List (Pattern i) → Doc

prettyPattern (var v)    = text v
prettyPattern (con c []) = text c
prettyPattern (con c ps) = parens $ text c <+> prettyPatterns ps

prettyPatterns = hsep ∘ List.map prettyPattern

-- Next we print terms. The Bool argument tells us whether we are on
-- the RHS of an application (in which case it is sensible to wrap
-- complex subterms in parentheses).

prettyTerm : ∀ {i} → Bool → Term i → Doc
prettyTerm l (var v)    = text v
prettyTerm l (app f []) = text f
prettyTerm l (app f es) = if l then parens else id
  $ text f <+> sep (List.map (prettyTerm true) es)
prettyTerm l (lam x b)  = if l then parens else id
  $ text "λ" <+> text x <> text "." <+> prettyTerm false b

-- We now have all the pieces to print definitions.
-- We print the equations below each other by using vcat.
--
-- The LHS is printed as follows: the name of the function followed by
-- the space-separated list of patterns (if any) and then an equal sign.
--
-- The RHS is printed as a term which is *not* on the RHS of an application.
--
-- Finally we can layout the definition in two different manners:
-- * either LHS followed by RHS
-- * or LHS followed and the RHS as a relative block (indented by 2 spaces)
--   on the next line

prettyDef : Def → Doc
prettyDef (fun by eqs) =
  vcat $ List⁺.toList $ flip List⁺.map eqs $ uncurry $ λ ps e →
  let lhs = text fun <+> (case ps of λ where
              [] → text "="
              _  → prettyPatterns (Vec.toList ps) <+> text "=")
      rhs = prettyTerm false e
  in lhs <+> rhs <|> lhs $$ (spaces 2 <> rhs)

-- The pretty printer is obtained by using the renderer.

pretty : Def → String
pretty = render ∘ prettyDef

------------------------------------------------------------------------
-- Some examples
------------------------------------------------------------------------

-- Our first example is the identity function defined as a λ-abstraction

`id : Def
`id = "id" by ([] , lam "x" (var "x")) ∷ []

_ : pretty `id ≡ "id = λ x. x"
_ = refl

-- If we were to assume that this definition also takes a level (a) and
-- a Set at that level (A) as arguments, we can have a slightly more complex
-- definition like so.

`explicitid : Def
`explicitid = "id" by (var "a" ∷ var "A" ∷ [] , lam "x" (var "x")) ∷ []

_ : pretty `explicitid ≡ "id a A = λ x. x"
_ = refl

-- A more complex example: boolFilter, a function that takes a boolean
-- predicate and a list as arguments and returns a list containing only
-- the values that satisfy the predicate.
-- We use nil and con for [] and _∷_ as our little toy language does not
-- support infix notations.

`filter : Def
`filter = "boolFilter"
  by ( var "P?" ∷ con "nil" [] ∷ []
     , app "nil" []
     )
   ∷ ( var "P?" ∷ con "con" (var "x" ∷ var "xs" ∷ []) ∷ []
     , let rec = app "filter" (var "P?" ∷ var "xs" ∷ []) in
       app "if" (app "P?" (var "x" ∷ [])
         ∷ app "con" (var "x" ∷ rec ∷ [])
         ∷ rec
         ∷ [])
     )
   ∷ []

_ : pretty `filter ≡
  "boolFilter P? nil = nil
\ \boolFilter P? (con x xs) = if (P? x) (con x (filter P? xs)) (filter P? xs)"
_ = refl

-- We can once more revisit this example with its more complex counterpart:
-- boolFilter taking its level and set arguments explicitly (idem for the
-- list constructors nil and con).
-- This time laying out the second equation on a single line would produce a
-- string larger than 80 characters long. So the pretty printer decides to
-- make the RHS a relative block indented by 2 spaces.

`explicitfilter : Def
`explicitfilter = "boolFilter"
  by ( var "a" ∷ var "A" ∷ var "P?" ∷ con "nil" [] ∷ []
     , app "nil" (var "a" ∷ var "A" ∷ [])
     )
   ∷ ( var "a" ∷ var "A" ∷ var "P?" ∷ con "con" (var "x" ∷ var "xs" ∷ []) ∷ []
     , let rec = app "filter" (var "a" ∷ var "A" ∷ var "P?" ∷ var "xs" ∷ []) in
       app "if" (app "P?" (var "x" ∷ [])
         ∷ app "con" (var "a" ∷ var "A" ∷ var "x" ∷ rec ∷ [])
         ∷ rec
         ∷ [])
     )
   ∷ []

_ : pretty `explicitfilter
  ≡ "boolFilter a A P? nil = nil a A
\   \boolFilter a A P? (con x xs) =
\   \  if (P? x) (con a A x (filter a A P? xs)) (filter a A P? xs)"
_ = refl