module calculus-examples where

open import Data.List using (List ; _∷_ ; [] ; _++_)
open import Data.List.Any using (here ; there ; any)
open import Data.List.Any.Properties
open import Data.OrderedListMap
open import Data.Sum using (inj₁ ; inj₂ ; _⊎_)
open import Data.Maybe.Base
open import Data.Empty using (⊥ ; ⊥-elim)
open import Data.Bool.Base using (true ; false)
open import Relation.Nullary using (Dec ; yes ; no ; ¬_)
open import Agda.Builtin.Equality using (refl ; _≡_)
open import Relation.Nullary.Decidable
  using (⌊_⌋)
open import Relation.Binary.PropositionalEquality
  using (subst ; cong ; sym ; trans)

open import calculus
open import utility

open import Esterel.Environment as Env
open import Esterel.Variable.Signal as Signal
  using (Signal ; _ₛ ; unknown ; present ; absent ; _≟ₛₜ_)
open import Esterel.Variable.Shared as SharedVar using (SharedVar)
open import Esterel.Variable.Sequential as SeqVar using (SeqVar)

open import Esterel.Lang
open import Esterel.Lang.CanFunction
open import Esterel.Lang.CanFunction.Properties
open import Esterel.Lang.CanFunction.SetSigMonotonic using (canₛ-set-sig-monotonic)
open import Esterel.Lang.Properties
open import Esterel.Lang.Binding
open import Esterel.Context
open import Esterel.CompletionCode as Code
  using () renaming (CompletionCode to Code)
open import context-properties
open import Esterel.Lang.CanFunction.Base using (canₛ-⊆-FV)

open import Data.Nat as Nat
  using (ℕ ; zero ; suc ; _+_) renaming (_⊔_ to _⊔ℕ_)
open import Data.Nat.Properties.Simple
  using (+-comm)
open import Data.Product
  using (Σ-syntax ; Σ ; _,_ ; _,′_ ; proj₁ ; proj₂ ; _×_)

open import eval

{-

This example is not true (and not provable under the current calculus)

{- rewriting a present to the true branch -}
{- cannot prove without the `signal` form -}
ex1 : ∀ S p q -> CB p ->
    signl S (emit S >> (present S ∣⇒ p ∣⇒ q)) ≡ₑ
    signl S (emit S >> p) # []
ex1 S p q CBp = calc where

  θS→unk : Env
  θS→unk = Θ SigMap.[ S ↦ Signal.unknown ] [] []

  S∈θS→unk : SigMap.∈Dom S (sig θS→unk)
  S∈θS→unk = sig-∈-single S Signal.unknown

  θS→unk[S]≡unk : sig-stats{S = S} θS→unk S∈θS→unk ≡ Signal.unknown
  θS→unk[S]≡unk = sig-stats-1map' S Signal.unknown S∈θS→unk

  θS→pre : Env
  θS→pre = set-sig{S} θS→unk S∈θS→unk Signal.present

  S∈θS→pre : SigMap.∈Dom S (sig θS→pre)
  S∈θS→pre = sig-set-mono' {S} {S} {θS→unk} {Signal.present} {S∈θS→unk} S∈θS→unk

  θS→pre[S]≡pre : sig-stats{S = S} θS→pre S∈θS→pre ≡ Signal.present
  θS→pre[S]≡pre = sig-putget{S} {θS→unk} {Signal.present} S∈θS→unk S∈θS→pre

  θS→unk[S]≠absent : ¬ sig-stats{S = S} θS→unk S∈θS→unk ≡ Signal.absent
  θS→unk[S]≠absent is rewrite θS→unk[S]≡unk = unknotabs is where
    unknotabs : Signal.unknown ≡ Signal.absent → ⊥
    unknotabs ()

  CBsignalS[emitS>>p] : CB (signl S (emit S >> p))
  CBsignalS[emitS>>p]
   = CBsig (CBseq (CBemit{S}) CBp ((λ z → λ ()) , (λ z → λ ()) , (λ z → λ ())))

  calc : signl S (emit S >> (present S ∣⇒ p ∣⇒ q)) ≡ₑ
         signl S (emit S >> p) # []
  calc =
    ≡ₑtran {r = (ρ θS→unk · (emit S >> (present S ∣⇒ p ∣⇒ q)))}
           (≡ₑstep [raise-signal])
   (≡ₑtran {r = (ρ θS→pre · (nothin >> (present S ∣⇒ p ∣⇒ q)))}
           (≡ₑstep ([emit] S∈θS→unk θS→unk[S]≠absent (deseq dehole)))
   (≡ₑtran {r = (ρ θS→pre · (present S ∣⇒ p ∣⇒ q))}
           (≡ₑctxt (dcenv dchole) (dcenv dchole) (≡ₑstep [seq-done]))
   (≡ₑtran {r = (ρ θS→pre · p)}
           (≡ₑstep ([is-present] S S∈θS→pre θS→pre[S]≡pre dehole))
   (≡ₑsymm CBsignalS[emitS>>p]
           (≡ₑtran {r = (ρ θS→unk · (emit S >> p))}
                   (≡ₑstep [raise-signal])
           (≡ₑtran {r = (ρ θS→pre · (nothin >> p))}
                   (≡ₑstep ([emit] S∈θS→unk θS→unk[S]≠absent (deseq dehole)))
           (≡ₑtran {r = ρ θS→pre · p}
                   (≡ₑctxt (dcenv dchole) (dcenv dchole) (≡ₑstep [seq-done]))
           ≡ₑrefl)))))))
           -}

Canₛpresent-fact : ∀ S p q ->
  (Signal.unwrap S) ∈ Canₛ (present S ∣⇒ p ∣⇒ q) (Θ SigMap.[ S ↦ Signal.unknown ] [] []) ->
  (Signal.unwrap S ∈ Canₛ p (Θ SigMap.[ S ↦ Signal.unknown ] [] [])) ⊎
  (Signal.unwrap S ∈ Canₛ q (Θ SigMap.[ S ↦ Signal.unknown ] [] []))
Canₛpresent-fact S  p q S∈Canₛ[presentSpq]
  with Env.Sig∈ S (Θ SigMap.[ S ↦ Signal.unknown ] [] [])
Canₛpresent-fact S p q S∈Canₛ[presentSpq] | yes S∈
  with  ⌊ present ≟ₛₜ (Env.sig-stats{S} (Θ SigMap.[ S ↦ Signal.unknown ] [] []) S∈) ⌋
Canₛpresent-fact S p q S∈Canₛ[presentSpq] | yes S∈ | true
 = inj₁ S∈Canₛ[presentSpq]
Canₛpresent-fact S p q S∈Canₛ[presentSpq] | yes S∈ | false
  with ⌊ absent ≟ₛₜ Env.sig-stats{S} (Θ SigMap.[ S ↦ Signal.unknown ] [] []) S∈ ⌋
Canₛpresent-fact S p q S∈Canₛ[presentSpq] | yes S∈ | false | true
  = inj₂ S∈Canₛ[presentSpq]
Canₛpresent-fact S p q S∈Canₛ[presentSpq] | yes S∈ | false | false
  =  ++⁻ (Canₛ p (Θ SigMap.[ S ↦ Signal.unknown ] [] [])) S∈Canₛ[presentSpq]
Canₛpresent-fact S p q _ | no ¬p
  = ⊥-elim (¬p (SigMap.update-in-keys [] S unknown))

{- rewriting a present to the false branch -}
ex2b : ∀ S p q C -> CB (C ⟦ signl S q ⟧c) ->
   Signal.unwrap S ∉ (Canₛ p (Θ SigMap.[ S ↦ unknown ] [] [])) ->
   Signal.unwrap S ∉ (Canₛ q (Θ SigMap.[ S ↦ unknown ] [] [])) ->
   signl S (present S ∣⇒ p ∣⇒ q) ≡ₑ
   signl S q # C
ex2b S p q C CBq s∉Canₛp s∉Canₛq = calc where

 θS→unk : Env
 θS→unk = Θ SigMap.[ S ↦ Signal.unknown ] [] []

 S∈θS→unk : SigMap.∈Dom S (sig θS→unk)
 S∈θS→unk = sig-∈-single S Signal.unknown

 θS→unk[S]≡unk : sig-stats{S = S} θS→unk S∈θS→unk ≡ Signal.unknown
 θS→unk[S]≡unk = sig-stats-1map' S Signal.unknown S∈θS→unk

 θS→abs : Env
 θS→abs = set-sig{S} θS→unk S∈θS→unk Signal.absent

 S∈θS→abs : SigMap.∈Dom S (sig θS→abs)
 S∈θS→abs = sig-set-mono' {S} {S} {θS→unk} {Signal.absent} {S∈θS→unk} S∈θS→unk

 θS→abs[S]≡abs : sig-stats{S = S} θS→abs S∈θS→abs ≡ Signal.absent
 θS→abs[S]≡abs = sig-putget{S} {θS→unk} {Signal.absent} S∈θS→unk S∈θS→abs

 S∉Canθₛq : Signal.unwrap S ∉ Canθₛ SigMap.[ S ↦ unknown ] 0 q []env
 S∉Canθₛq S∈Canθₛq = s∉Canₛq (Canθₛunknown->Canₛunknown S q S∈Canθₛq)

 S∉CanθₛpresentSpq : Signal.unwrap S ∉ Canθₛ SigMap.[ S ↦ unknown ]
                                            0
                                            (present S ∣⇒ p ∣⇒ q)
                                            []env
 S∉CanθₛpresentSpq S∈Canθₛ
   with Canθₛunknown->Canₛunknown S (present S ∣⇒ p ∣⇒ q) S∈Canθₛ
 ... | fact
   with Canₛpresent-fact S p q fact
 ... | inj₁ s∈Canₛp = s∉Canₛp s∈Canₛp
 ... | inj₂ s∈Canₛq = s∉Canₛq s∈Canₛq

 bwd : signl S q ≡ₑ (ρ⟨ θS→abs , WAIT ⟩· q) # C
 bwd =
    ≡ₑtran (≡ₑstep [raise-signal])
   (≡ₑtran (≡ₑstep ([absence] S S∈θS→unk θS→unk[S]≡unk S∉Canθₛq))
    ≡ₑrefl)

 fwd : signl S (present S ∣⇒ p ∣⇒ q) ≡ₑ
       (ρ⟨ θS→abs , WAIT ⟩· q) # C
 fwd =
     ≡ₑtran (≡ₑstep [raise-signal])
    (≡ₑtran (≡ₑstep ([absence] S S∈θS→unk θS→unk[S]≡unk S∉CanθₛpresentSpq))
    (≡ₑtran (≡ₑstep ([is-absent] S S∈θS→abs θS→abs[S]≡abs dehole))
     ≡ₑrefl)) where

 calc :  signl S (present S ∣⇒ p ∣⇒ q) ≡ₑ
         signl S q # C
 calc = ≡ₑtran fwd (≡ₑsymm CBq bwd)

ex2 : ∀ S p q C ->
   CB (C ⟦ signl S q ⟧c) ->
   (∀ status -> Signal.unwrap S ∉ (Canₛ p (Θ SigMap.[ S ↦ status ] [] []))) ->
   (∀ status -> Signal.unwrap S ∉ (Canₛ q (Θ SigMap.[ S ↦ status ] [] []))) ->
   signl S (present S ∣⇒ p ∣⇒ q) ≡ₑ
   signl S q # C
ex2 S p q C CB noSp noSq = ex2b S p q C CB (noSp unknown) (noSq unknown)

{-
 Although true, the this example is not provable under the current calculus
{- lifting an emit out of a par -}
ex3 : ∀ S p q -> CB (p ∥ q) ->
  signl S ((emit S >> p) ∥ q) ≡ₑ
  signl S  (emit S >> (p ∥ q)) # []
ex3 S p q CBp∥q = calc where

  θS→unk : Env
  θS→unk = Θ SigMap.[ S ↦ Signal.unknown ] [] []

  S∈θS→unk : SigMap.∈Dom S (sig θS→unk)
  S∈θS→unk = sig-∈-single S Signal.unknown

  θS→unk[S]≡unk : sig-stats{S = S} θS→unk S∈θS→unk ≡ Signal.unknown
  θS→unk[S]≡unk = sig-stats-1map' S Signal.unknown S∈θS→unk

  θS→pre : Env
  θS→pre = set-sig{S} θS→unk S∈θS→unk Signal.present

  θS→unk[S]≠absent : ¬ sig-stats{S = S} θS→unk S∈θS→unk ≡ Signal.absent
  θS→unk[S]≠absent is rewrite θS→unk[S]≡unk = unknotabs is where
    unknotabs : Signal.unknown ≡ Signal.absent → ⊥
    unknotabs ()

  calc : signl S ((emit S >> p) ∥ q) ≡ₑ
         signl S  (emit S >> (p ∥ q)) # []
  calc =
    ≡ₑtran {r = ρ⟨ θS→unk · ((emit S >> p) ∥ q)}
           (≡ₑstep [raise-signal])
   (≡ₑtran {r = ρ θS→pre · (nothin >> p ∥ q)}
           (≡ₑstep ([emit]{S = S} S∈θS→unk θS→unk[S]≠absent (depar₁ (deseq dehole))))
   (≡ₑtran {r = ρ θS→pre · (p ∥ q)}
           (≡ₑctxt (dcenv (dcpar₁ dchole))
                   (dcenv (dcpar₁ dchole))
                   (≡ₑstep [seq-done]))
           (≡ₑsymm (CBsig (CBseq CBemit CBp∥q
                                 (((λ z → λ ()) ,
                                   (λ z → λ ()) ,
                                   (λ z → λ ())))))
                   (≡ₑtran {r = ρ θS→unk · (emit S >> (p ∥ q))}
                           (≡ₑstep [raise-signal])
                   (≡ₑtran (≡ₑstep ([emit] S∈θS→unk θS→unk[S]≠absent (deseq dehole)))
                           (≡ₑctxt (dcenv dchole)  (dcenv dchole) (≡ₑstep [seq-done])))))))
                           -}

{- pushing a trap across a par -}
ex4 : ∀ n p q -> CB p ->
      done q -> p ≡ₑ q # [] ->
      (trap (exit (suc n) ∥ p)) ≡ₑ (exit n ∥ trap p) # []

ex4 = ex4-split where

  basealwaysdistinct : ∀ x -> distinct base x
  basealwaysdistinct x = (λ { z () x₂ }) , (λ { z () x₂ }) , (λ { z () x₂})

  CBplugrpartrap : ∀ n -> ∀ {r r′ BVp FVp} ->
      CorrectBinding r BVp FVp →
      r′ ≐ ceval (epar₂ (exit n)) ∷ ceval etrap ∷ [] ⟦ r ⟧c →
      CB r′
  CBplugrpartrap n {p} {p′} {BVp} {FVp} CBp r′dc
    with BVFVcorrect p BVp FVp CBp | unplugc r′dc
  ... | refl , refl | refl = CBpar CBexit (CBtrap CBp)
                                   (basealwaysdistinct BVp)
                                   (basealwaysdistinct (BVars p))
                                   (basealwaysdistinct (FVars p))
                                   (λ { _ () _ })

  CBplugtraprpar : ∀ n -> {r r′ : Term}
      {BVp FVp : Σ (List ℕ) (λ x → List ℕ × List ℕ)} →
      CorrectBinding r BVp FVp →
      r′ ≐ ceval etrap ∷ ceval (epar₂ (exit (suc n))) ∷ [] ⟦ r ⟧c →
      CB r′
  CBplugtraprpar n {r} {r′} {BVp} {FVp} CBr r′C
    with unplugc r′C
  ... | refl
    with BVFVcorrect r BVp FVp CBr
  ... | refl , refl
   = CBtrap (CBpar CBexit CBr
                   (basealwaysdistinct BVp)
                   (basealwaysdistinct (BVars r))
                   (basealwaysdistinct (FVars r))
                   (λ { _ () _}))

  ex4-split : ∀ n p q -> CB p ->
              done q -> p ≡ₑ q # [] ->
              (trap (exit (suc n) ∥ p)) ≡ₑ (exit n ∥ trap p) # []
  ex4-split n p .nothin CBp (dhalted hnothin) p≡ₑnothin =
    ≡ₑtran {r = trap (exit (suc n) ∥ nothin)}
           (≡ₑctxt (dctrap (dcpar₂ dchole))
                   (dctrap (dcpar₂ dchole))
                   (≡ₑ-context [] _ (CBplugtraprpar n) p≡ₑnothin))
    (≡ₑtran {r = trap (exit (suc n))}
            (≡ₑctxt (dctrap dchole)
                    (dctrap dchole)
                    (≡ₑtran (≡ₑstep [par-swap])
                            (≡ₑstep ([par-nothing] (dhalted (hexit (suc n)))))))
    (≡ₑtran {r = exit n}
            (≡ₑstep ([trap-done] (hexit (suc n))))
    (≡ₑsymm (CBpar CBexit (CBtrap CBp)
                   (basealwaysdistinct (BVars p))
                   (basealwaysdistinct (BVars p))
                   (basealwaysdistinct (FVars p))
                   (λ { _ () _ }))
            (≡ₑtran {r = exit n ∥ trap nothin}
                    (≡ₑctxt (dcpar₂ (dctrap dchole))
                            (dcpar₂ (dctrap dchole))
                            (≡ₑ-context [] _ (CBplugrpartrap n) p≡ₑnothin))
            (≡ₑtran {r = exit n ∥ nothin}
                    (≡ₑctxt (dcpar₂ dchole) (dcpar₂ dchole) (≡ₑstep ([trap-done] hnothin)))
            (≡ₑtran {r = nothin ∥ exit n}
                    (≡ₑstep [par-swap])
            (≡ₑtran {r = exit n}
                    (≡ₑstep ([par-nothing] (dhalted (hexit n))))
            ≡ₑrefl)))))))

  ex4-split n p .(exit 0) CBp (dhalted (hexit 0)) p≡ₑexit0 =
    ≡ₑtran {r = trap (exit (suc n) ∥ exit 0) }
           (≡ₑctxt (dctrap (dcpar₂ dchole))
                   (dctrap (dcpar₂ dchole))
                   (≡ₑ-context [] _ (CBplugtraprpar n) p≡ₑexit0))
           (≡ₑtran {r = trap (exit (suc n))}
                   (≡ₑctxt (dctrap dchole) (dctrap dchole)
                           (≡ₑstep ([par-2exit] (suc n) zero)))
           (≡ₑtran {r = exit n}
                   (≡ₑstep ([trap-done] (hexit (suc n))))
           (≡ₑsymm (CBpar CBexit (CBtrap CBp)
                          (basealwaysdistinct (BVars p))
                          (basealwaysdistinct (BVars p))
                          (basealwaysdistinct (FVars p))
                          (λ { _ () _ }))
                   (≡ₑtran {r = exit n ∥ trap (exit 0)}
                           (≡ₑctxt (dcpar₂ (dctrap dchole))
                                   (dcpar₂ (dctrap dchole))
                                   (≡ₑ-context [] _ (CBplugrpartrap n) p≡ₑexit0))
                   (≡ₑtran {r = exit n ∥ nothin }
                           (≡ₑctxt (dcpar₂ dchole) (dcpar₂ dchole)
                                   (≡ₑstep ([trap-done] (hexit zero))))
                   (≡ₑtran {r = nothin ∥ exit n}
                           (≡ₑstep [par-swap])
                   (≡ₑtran {r = exit n}
                           (≡ₑstep ([par-nothing] (dhalted (hexit n))))
                   ≡ₑrefl)))))))

  ex4-split n p .(exit (suc m)) CBp (dhalted (hexit (suc m))) p≡ₑexitm =
    ≡ₑtran {r = trap (exit (suc n) ∥ exit (suc m)) }
           (≡ₑctxt (dctrap (dcpar₂ dchole))
                   (dctrap (dcpar₂ dchole))
                   (≡ₑ-context [] _ (CBplugtraprpar n) p≡ₑexitm))
    (≡ₑtran {r = trap (exit (suc n ⊔ℕ (suc m)))}
            (≡ₑctxt (dctrap dchole) (dctrap dchole)
                    (≡ₑstep ([par-2exit] (suc n) (suc m))))
    (≡ₑtran {r = ↓_ {p = (exit (suc n ⊔ℕ (suc m)))} (hexit (suc n ⊔ℕ (suc m))) }
            (≡ₑstep ([trap-done] (hexit (suc (n ⊔ℕ m)))))
    (≡ₑsymm (CBpar CBexit (CBtrap CBp)
                          (basealwaysdistinct (BVars p))
                          (basealwaysdistinct (BVars p))
                          (basealwaysdistinct (FVars p))
                          (λ { _ () _ }))
            (≡ₑtran {r = exit n ∥ trap (exit (suc m))}
                    (≡ₑctxt (dcpar₂ (dctrap dchole))
                            (dcpar₂ (dctrap dchole))
                            (≡ₑ-context [] _ (CBplugrpartrap n) p≡ₑexitm))
            (≡ₑtran {r = exit n ∥  ↓_ {p = exit (suc m)} (hexit (suc m))}
                    (≡ₑctxt (dcpar₂ dchole) (dcpar₂ dchole)
                            (≡ₑstep ([trap-done] (hexit (suc m)))) )
            (≡ₑtran {r =  ↓_ {p = (exit (suc n ⊔ℕ (suc m)))} (hexit (suc n ⊔ℕ (suc m))) }
                    (≡ₑstep ([par-2exit] n m))
            ≡ₑrefl))))))

  ex4-split n p q CBp (dpaused pausedq) p≡ₑq =
    ≡ₑtran {r = trap (exit (suc n) ∥ q)}
           (≡ₑctxt (dctrap (dcpar₂ dchole))
                   (dctrap (dcpar₂ dchole))
                   (≡ₑ-context [] _ (CBplugtraprpar n) p≡ₑq))
    (≡ₑtran {r = trap (exit (suc n))}
            (≡ₑctxt (dctrap dchole) (dctrap dchole)
                    (≡ₑstep ([par-1exit] (suc n) pausedq)))
    (≡ₑtran {r = exit n}
            (≡ₑstep ([trap-done] (hexit (suc n))))
    (≡ₑsymm (CBpar CBexit (CBtrap CBp)
                        (basealwaysdistinct (BVars p))
                        (basealwaysdistinct (BVars p))
                        (basealwaysdistinct (FVars p))
                        (λ { _ () _ }))
            (≡ₑtran {r = exit n ∥ trap q}
                    (≡ₑctxt (dcpar₂ (dctrap dchole))
                            (dcpar₂ (dctrap dchole))
                            (≡ₑ-context [] _ (CBplugrpartrap n) p≡ₑq))
            (≡ₑtran {r = exit n}
                    (≡ₑstep ([par-1exit] n (ptrap pausedq)))
            ≡ₑrefl)))))

{- lifting a signal out of an evaluation context -}
ex5 : ∀ S p q r E -> CB r ->
      q ≐ E ⟦(signl S p)⟧e ->
      r ≐ E ⟦ p ⟧e ->
      (ρ⟨ []env , WAIT ⟩· q) ≡ₑ (ρ⟨ []env , WAIT ⟩· (signl S r)) # []
ex5 S p q r E CBr decomp1 decomp2 = calc where

  θS→unk : Env
  θS→unk = Θ SigMap.[ S ↦ Signal.unknown ] [] []

  replugit : q ≐ Data.List.map ceval E ⟦ signl S p ⟧c ->
             E ⟦ ρ⟨ θS→unk , WAIT ⟩· p ⟧e ≐ Data.List.map ceval E ⟦ ρ⟨ θS→unk , WAIT ⟩· p ⟧c
  replugit x = ⟦⟧e-to-⟦⟧c Erefl

  calc : (ρ⟨ []env , WAIT ⟩· q) ≡ₑ (ρ⟨ []env , WAIT ⟩· (signl S r)) # []
  calc =
    ≡ₑtran {r = ρ⟨ []env , WAIT ⟩· (E ⟦ (ρ⟨ θS→unk , WAIT ⟩· p) ⟧e)}
           (≡ₑctxt (dcenv (⟦⟧e-to-⟦⟧c decomp1))
                   (dcenv (replugit (⟦⟧e-to-⟦⟧c decomp1)))
                   (≡ₑstep [raise-signal]))
   (≡ₑtran {r = ρ⟨ θS→unk , WAIT ⟩· (E ⟦ p ⟧e)}
           (≡ₑstep ([merge]{E = E} Erefl))
           (≡ₑsymm (CBρ (CBsig CBr))
                 (≡ₑtran {r = ρ⟨ []env , WAIT ⟩· (ρ⟨ θS→unk , WAIT ⟩· r)}
                         (≡ₑctxt (dcenv dchole) (dcenv dchole) (≡ₑstep [raise-signal]))
                         (≡ₑstep ([merge] {E = []}
                                          (subst (\ x ->
                                            ρ⟨ θS→unk , WAIT ⟩· x ≐ [] ⟦
                                            ρ⟨ θS→unk , WAIT ⟩· E ⟦ p ⟧e ⟧e)
                                            (unplug decomp2) dehole))))))

{- two specific examples of lifting a signal out of an evaluation context -}
ex6 : ∀ S p q -> CB (p ∥ q) ->
      (ρ⟨ []env , WAIT ⟩· ((signl S p) ∥ q)) ≡ₑ (ρ⟨ []env , WAIT ⟩· (signl S (p ∥ q))) # []
ex6 S p q CBp∥q =
  ex5 S p (signl S p ∥ q) (p ∥ q) ((epar₁ q) ∷ []) CBp∥q (depar₁ dehole) (depar₁ dehole)

ex7 : ∀ S p q -> CB (p >> q) ->
      (ρ⟨ []env , WAIT ⟩· ((signl S p) >> q)) ≡ₑ (ρ⟨ []env , WAIT ⟩· (signl S (p >> q))) # []
ex7 S p q CBp>>q =
  ex5 S p (signl S p >> q) (p >> q) ((eseq q) ∷ []) CBp>>q (deseq dehole) (deseq dehole)

{- pushing a seq into a binding form (a signal in this case).

   this shows the need for the outer environment ρ [} · _
   in order to manipulate the environment.
-}
ex8-worker : ∀ {BV FV} S p q ->
      CorrectBinding ((signl S  p) >> q) BV FV ->
      (ρ⟨ []env , WAIT ⟩· (signl S  p) >> q) ≡ₑ
      (ρ⟨ []env , WAIT ⟩·  signl S (p  >> q)) # []
ex8-worker S p q (CBseq {BVp = BVsigS·p} {FVq = FVq} (CBsig {BV = BVp} CBp) CBq BVsigS·p≠FVq) =
             ≡ₑtran {r = ρ⟨ []env , WAIT ⟩· (ρ⟨ [S]-env S , WAIT ⟩· p) >> q} {C = []}
               (≡ₑctxt {C = []} {C′ = cenv []env WAIT ∷ ceval (eseq q) ∷ []}
                 Crefl Crefl
                 (≡ₑstep ([raise-signal] {p} {S})))
            (≡ₑtran {r = ρ⟨ [S]-env S , WAIT ⟩· p >> q} {C = []}
               (≡ₑstep ([merge] (deseq dehole)))
            (≡ₑsymm
              (CBρ
                (CBsig
                  (CBseq CBp CBq
                    (⊆-respect-distinct-left (∪ʳ (+S S base) ⊆-refl) BVsigS·p≠FVq))))
            (≡ₑtran {r = ρ⟨ []env , WAIT ⟩· (ρ⟨ [S]-env S , WAIT ⟩· p >> q)} {C = []}
              (≡ₑctxt {C = []} {C′ = cenv []env WAIT ∷ []}
                Crefl Crefl
                (≡ₑstep ([raise-signal] {p >> q} {S})))
            (≡ₑstep ([merge] dehole)))))

ex8 : ∀ S p q ->
             CB ((signl S  p) >> q) ->
      (ρ⟨ []env , WAIT ⟩· (signl S  p) >> q) ≡ₑ
      (ρ⟨ []env , WAIT ⟩·  signl S (p  >> q)) # []
ex8 S p q cb = ex8-worker S p q cb

{- rearranging signal forms -}
ex9 : ∀ S1 S2 p ->
     CB p ->
     signl S1 (signl S2 p) ≡ₑ signl S2 (signl S1 p) # []
ex9 S1 S2 p CBp =
  ≡ₑtran {r = ρ⟨ (Θ SigMap.[ S1 ↦ Signal.unknown ] [] []) , WAIT ⟩· (signl S2 p)}
         (≡ₑstep [raise-signal])
 (≡ₑtran {r = (ρ⟨ Θ SigMap.[ S1 ↦ Signal.unknown ] [] [] , WAIT ⟩·
              (ρ⟨ Θ SigMap.[ S2 ↦ Signal.unknown ] [] [] , WAIT ⟩· p))}
         (≡ₑctxt (dcenv dchole) (dcenv dchole) (≡ₑstep [raise-signal]))
 (≡ₑtran {r = (ρ⟨ (Θ SigMap.[ S1 ↦ Signal.unknown ] [] []) ←
               (Θ SigMap.[ S2 ↦ Signal.unknown ] [] []) , A-max WAIT WAIT ⟩·
               p)}
         (≡ₑstep ([merge] dehole))
 (≡ₑsymm (CBsig (CBsig CBp))
         (≡ₑtran {r = ρ⟨ (Θ SigMap.[ S2 ↦ Signal.unknown ] [] []) , WAIT ⟩· (signl S1 p)}
                 (≡ₑstep [raise-signal])
         (≡ₑtran {r = (ρ⟨ Θ SigMap.[ S2 ↦ Signal.unknown ] [] [] , WAIT ⟩·
                        (ρ⟨ Θ SigMap.[ S1 ↦ Signal.unknown ] [] [] , WAIT ⟩· p))}
                 (≡ₑctxt (dcenv dchole) (dcenv dchole) (≡ₑstep [raise-signal]))
         (≡ₑtran {r = (ρ⟨ (Θ SigMap.[ S2 ↦ Signal.unknown ] [] []) ←
                        (Θ SigMap.[ S1 ↦ Signal.unknown ] [] []) ,
                        A-max WAIT WAIT ⟩·
                          p)}
                 (≡ₑstep ([merge] dehole))
                 (map-order-irr S1 S2 WAIT p))))))) where

  distinct-Ss-env'' : ∀ S1 S2 S3 ->
     ¬ Signal.unwrap S1 ≡ Signal.unwrap S2 ->
     Data.List.Any.Any (_≡_ S3) (Signal.unwrap S1 ∷ []) ->
     Data.List.Any.Any (_≡_ S3) (Signal.unwrap S2 ∷ []) ->
     ⊥
  distinct-Ss-env'' S1 S2 S3 S1≠S2 (here S3=S1) (here S3=S2) rewrite S3=S1 = S1≠S2 S3=S2
  distinct-Ss-env'' S1 S2 S3 S1≠S2 (here px) (there ())
  distinct-Ss-env'' S1 S2 S3 S1≠S2 (there ()) S3∈Domθ2

  distinct-Ss-env' : ∀ S1 S2 S3 ->
     ¬ Signal.unwrap S1 ≡ Signal.unwrap S2 ->
     Data.List.Any.Any (_≡_ S3) (Signal.unwrap S1 ∷ []) ->
     S3 ∈ proj₁ (Dom (Θ SigMap.[ S2 ↦ Signal.unknown ] [] [])) ->
     ⊥
  distinct-Ss-env' S1 S2 S3 S1≠S2 S3∈Domθ1 S3∈Domθ2
     rewrite SigMap.keys-1map S2 Signal.unknown =
       distinct-Ss-env'' S1 S2 S3 S1≠S2 S3∈Domθ1 S3∈Domθ2

  distinct-Ss-env : ∀ S1 S2 S3 ->
     ¬ Signal.unwrap S1 ≡ Signal.unwrap S2 ->
     S3 ∈ proj₁ (Dom (Θ SigMap.[ S1 ↦ Signal.unknown ] [] [])) ->
     S3 ∈ proj₁ (Dom (Θ SigMap.[ S2 ↦ Signal.unknown ] [] [])) ->
     ⊥
  distinct-Ss-env S1 S2 S3 S1≠S2 S3∈Domθ1 S3∈Domθ2
    rewrite SigMap.keys-1map S1 Signal.unknown =
      distinct-Ss-env' S1 S2 S3 S1≠S2 S3∈Domθ1 S3∈Domθ2

  distinct-doms : ∀ S1 S2 ->
    ¬ (Signal.unwrap S1 ≡ Signal.unwrap S2) ->
    distinct (Env.Dom (Θ SigMap.[ S1 ↦ Signal.unknown ] [] []))
             (Env.Dom (Θ SigMap.[ S2 ↦ Signal.unknown ] [] []))
  distinct-doms S1 S2 S1≠S2 =
    (λ {S3 S3∈θ1 S3∈θ2 -> distinct-Ss-env S1 S2 S3 S1≠S2 S3∈θ1 S3∈θ2})
    ,
    (λ x₁ x₂ → λ ())
    ,
    (λ x₁ x₂ → λ ())

  map-order-irr' : ∀ S1 S2 ->
     (Θ SigMap.[ S1 ↦ Signal.unknown ] [] []) ←
     (Θ SigMap.[ S2 ↦ Signal.unknown ] [] [])
     ≡
     (Θ SigMap.[ S2 ↦ Signal.unknown ] [] []) ←
     (Θ SigMap.[ S1 ↦ Signal.unknown ] [] [])
  map-order-irr' S1 S2 with (Signal.unwrap S1) Nat.≟ (Signal.unwrap S2)
  map-order-irr' S1 S2 | yes S1=S2 rewrite S1=S2 = refl
  map-order-irr' S1 S2 | no ¬S1=S2 =  Env.←-comm
                               ((Θ SigMap.[ S1 ↦ Signal.unknown ] [] []))
                               ((Θ SigMap.[ S2 ↦ Signal.unknown ] [] []))
                               (distinct-doms S1 S2 ¬S1=S2)

  map-order-irr : ∀ S1 S2 A p ->
       (ρ⟨
         Θ SigMap.[ S2 ↦ Signal.unknown ] [] [] ←
         Θ SigMap.[ S1 ↦ Signal.unknown ] [] []
         ,
         A ⟩· p)
        ≡ₑ
        (ρ⟨
         Θ SigMap.[ S1 ↦ Signal.unknown ] [] [] ←
         Θ SigMap.[ S2 ↦ Signal.unknown ] [] []
         ,
         A ⟩· p) # []
  map-order-irr S1 S2 A p rewrite map-order-irr' S1 S2 = ≡ₑrefl

{- dropping a loop whose body is just `exit` -}

ex10 : ∀ C n -> (loop (exit n)) ≡ₑ (exit n) # C
ex10 C n = ≡ₑtran (≡ₑstep [loop-unroll]) (≡ₑstep [loopˢ-exit])

{- (nothin ∥ p) ≡ₑ p, but only if we know that
   p goes to something that's done -}
ex11 : ∀ p q ->
  CB p -> done q -> p ≡ₑ q # [] ->
  (nothin ∥ p) ≡ₑ p # []
ex11 = calc where

  ex11-pq : ∀ q C -> done q -> (nothin ∥ q) ≡ₑ q # C
  ex11-pq .nothin C (dhalted hnothin) =
    ≡ₑtran (≡ₑstep [par-swap]) (≡ₑstep ([par-nothing] (dhalted hnothin)))
  ex11-pq .(exit n) C (dhalted (hexit n)) =
    ≡ₑstep ([par-nothing] (dhalted (hexit n)))
  ex11-pq q C (dpaused p/paused) =
   ≡ₑstep ([par-nothing] (dpaused p/paused))

  basealwaysdistinct : ∀ x -> distinct base x
  basealwaysdistinct x = (λ { z () x₂ }) , (λ { z () x₂ }) , (λ { z () x₂})

  CBp->CBnothingp : {r r′ : Term}
      {BVp FVp : Σ (List ℕ) (λ x → List ℕ × List ℕ)} →
      CorrectBinding r BVp FVp →
      r′ ≐ ceval (epar₂ nothin) ∷ [] ⟦ r ⟧c → CB r′
  CBp->CBnothingp {r} CBr r′dc
   with sym (unplugc r′dc) | BVFVcorrect _ _ _ CBr
  ... | refl | refl , refl
   = CBpar CBnothing CBr
      (basealwaysdistinct (BVars r))
      (basealwaysdistinct (BVars r))
      (basealwaysdistinct (FVars r))
      (λ { _ () _ })

  calc : ∀ p q ->
    CB p -> done q -> p ≡ₑ q # [] ->
    (nothin ∥ p) ≡ₑ p # []
  calc p q CBp doneq p≡ₑq =
    ≡ₑtran {r = (nothin ∥ q)}
           (≡ₑctxt (dcpar₂ dchole)
                   (dcpar₂ dchole)
                   (≡ₑ-context [] _ CBp->CBnothingp p≡ₑq))
           (≡ₑtran {r = q} (ex11-pq q [] doneq) (≡ₑsymm CBp p≡ₑq))

{- although true, can no longer prove
{- an emit (first) in sequence is the same as emit in parallel -}
ex12 : ∀ S p q ->
      CB p -> done q -> p ≡ₑ q # [] ->
      (signl S ((emit S) ∥ p)) ≡ₑ (signl S ((emit S) >> p)) # []
ex12 S p q CBp doneq p≡ₑq = calc where

  θS→unk : Env
  θS→unk = Θ SigMap.[ S ↦ Signal.unknown ] [] []

  S∈θS→unk : SigMap.∈Dom S (sig θS→unk)
  S∈θS→unk = sig-∈-single S Signal.unknown

  θS→unk[S]≡unk : sig-stats{S = S} θS→unk S∈θS→unk ≡ Signal.unknown
  θS→unk[S]≡unk = sig-stats-1map' S Signal.unknown S∈θS→unk

  θS→pre : Env
  θS→pre = set-sig{S} θS→unk S∈θS→unk Signal.present

  θS→unk[S]≠absent : ¬ sig-stats{S = S} θS→unk S∈θS→unk ≡ Signal.absent
  θS→unk[S]≠absent is rewrite θS→unk[S]≡unk = unknotabs is where
    unknotabs : Signal.unknown ≡ Signal.absent → ⊥
    unknotabs ()

  CBp->CBρθSp : {r r′ : Term}
      {BVp FVp : Σ (List ℕ) (λ x → List ℕ × List ℕ)} →
      CorrectBinding r BVp FVp → r′ ≐ cenv θS→pre ∷ [] ⟦ r ⟧c → CB r′
  CBp->CBρθSp {r} CBr r′dc
    with sym (unplugc r′dc) | BVFVcorrect _ _ _ CBr
  ... | refl | refl , refl = CBρ CBr

  basealwaysdistinct : ∀ x -> distinct base x
  basealwaysdistinct x = (λ { z () x₂ }) , (λ { z () x₂ }) , (λ { z () x₂})

  CBsiglSemitS>>p : CB (signl S (emit S >> p))
  CBsiglSemitS>>p =
    CBsig (CBseq CBemit CBp (basealwaysdistinct (FVars p)))

  calc : (signl S ((emit S) ∥ p)) ≡ₑ
         (signl S ((emit S) >> p)) # []
  calc =
     ≡ₑtran {r = ρ θS→unk · ((emit S) ∥ p)}
            (≡ₑstep [raise-signal])
    (≡ₑtran {r =  ρ θS→pre · (nothin ∥ p)}
            (≡ₑstep ([emit] S∈θS→unk θS→unk[S]≠absent (depar₁ dehole)))
    (≡ₑtran {r = ρ θS→pre · p}
            (≡ₑctxt (dcenv dchole) (dcenv dchole)
                    (≡ₑ-context [] (cenv _ ∷ [])
                                CBp->CBρθSp
                                (ex11 p q CBp doneq p≡ₑq)))
    (≡ₑsymm CBsiglSemitS>>p
            (≡ₑtran {r = ρ θS→unk · (emit S >> p)}
                    (≡ₑstep [raise-signal])
            (≡ₑtran {r = ρ θS→pre · nothin >> p}
                    (≡ₑstep ([emit] S∈θS→unk θS→unk[S]≠absent (deseq dehole)))
                    (≡ₑctxt (dcenv dchole) (dcenv dchole)
                            (≡ₑstep [seq-done])))))))

-}


module Issue478c where

record Ko (Q : Set) : Set₁ where
 field
  T : Set

foo : (Q : Set)(ko : Ko Q) → Ko.T ko
foo Q ko = Set

-- We should make sure not to destroy printing
-- outside the record module. Type should be
-- printed as it's given: Ko.T ko


module MJSF.Examples.Integer where

open import Prelude
open import Data.Maybe
open import Data.Star
open import Data.Bool
open import Data.List
open import Data.Integer
open import Data.List.Membership.Propositional
open import Data.List.Relation.Unary.Any
open import Data.List.Relation.Unary.All as All hiding (lookup)
open import Data.Product hiding (Σ)
open import Relation.Binary.PropositionalEquality
open import Relation.Nullary.Decidable

k : ℕ
k = 5

open import MJSF.Syntax k
open import ScopesFrames.ScopesFrames k Ty

{-
    class Integer {
      int x = 0;
      void set(Integer b) {
        this.x = b.get()
      }
    }
-}

classes : List Ty
classes = (cᵗ (# 0) (# 1) ∷ [])

intmethods intfields : List Ty
intfields =
  {- x -} vᵗ int
  ∷ []
intmethods =
  {- set -} mᵗ ((ref (# 1)) ∷ []) void
  ∷ []

Integer : Scope
Integer = # 1

g : Graph
-- root scope
g zero = classes , []
-- class scope of Integer class
g (suc zero)= (intmethods ++ intfields) , zero ∷ []
-- scope of Integer.set method
g (suc (suc zero)) = (vᵗ (ref (# 1)) ∷ []) , # 1 ∷ []
-- scopes of main
g (suc (suc (suc zero))) = vᵗ (ref Integer) ∷ [] , (# 0 ∷ [])
g (suc (suc (suc (suc zero)))) = vᵗ (ref Integer) ∷ [] , # 3 ∷ []
g (suc (suc (suc (suc (suc ())))))

open SyntaxG g
open UsesGraph g

IntegerImpl : Class (# 0) (# 1)
IntegerImpl = class0 {ms = intmethods}{intfields}{[]}
  (-- methods
    (#m' (meth (# 2) (body-void
    (set
      (this [] (here refl))
      (path [] (there (here refl)))
      (get (var (path [] (here refl))) (path [] (there (here refl))))
    ◅ ε)))) ∷ [])
  (-- fields
    (#v' tt) ∷ [])
  []

{-
  int main() {
    Integer x;
    Integer y;
    x = new Integer();
    y = new Integer();
    x.x = 9;
    y.x = 18;
    y.set(x);
    return y.x;
  }
-}
main : Body (# 0) int
main = body
    (
        loc (# 3) (ref Integer)
      ◅ loc (# 4) (ref Integer)
      ◅ asgn (path (here refl ∷ []) (here refl)) (new (path (here refl ∷ here refl ∷ []) (here refl)))
      ◅ asgn (path [] (here refl)) (new (path (here refl ∷ here refl ∷ []) (here refl)))
      ◅ set (var (path (here refl ∷ []) (here refl))) (path [] (there (here refl))) (num (+ 9))
      ◅ set (var (path [] (here refl))) (path [] (there (here refl))) (num (+ 18))
      ◅ run (call (var (path [] (here refl))) (path [] (here refl)) (var (path (here refl ∷ []) (here refl)) ∷ []))
      ◅ ε
    )
    (get (var (path [] (here refl))) (path [] (there (here refl))))

p : Program (# 0) int
p = program classes (#c' (IntegerImpl , # 1 , obj (# 1) ⦃ refl ⦄)  ∷ []) main

open import MJSF.Semantics
open Semantics _ g
open import MJSF.Values
open ValuesG _ g

test : p ⇓⟨ 100 ⟩ (λ v → v ≡ num (+ 9) )
test = refl


-- Andreas, 2020-02-15, issue #4447
--
-- Positivity checker needs to see the constructor types
-- in the same way as the type checker has seen them.
--
-- Thus, we need to reduce types of constructors even
-- with definitions that have not yet been subjected to termination
-- checking, e.g. because they live in a mutual block with the data type.

-- {-# OPTIONS -v term:10 #-}
-- {-# OPTIONS -v tc.pos:10 #-}
-- {-# OPTIONS -v tc.data:10 #-}

data ⊥ : Set where

-- Mutual block:

data D : Set
D' = (D → ⊥) → D
data D where
  abs : D'

-- Positivity checker needs to unfold D', otherwise it does not see
-- the correct occurrences of D.

-- From here, the road to absurdity is paved:

app : D → D → ⊥
app (abs f) = f

delta : D → ⊥
delta x = app x x

Omega : ⊥
Omega = delta (abs delta)


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

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

postulate
  A : Set
  a b : A

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

  rewf₁ : f (A → A) (λ _ → a) ≡ a
  rewf₂ : (X : Set) → f X (g X) ≡ b

  rewg : (x : A) → g (A → A) x ≡ a

test = f (A → A) (λ x → g (A → A) x)

{-# REWRITE rewf₁ rewg #-}

foo : test ≡ a
foo = refl

{-# REWRITE rewf₂ #-}

bar : test ≡ b
bar = refl

fails : a ≡ b
fails = refl


module Function.Axioms where

open import Lang.Instance
open import Logic.Predicate
open import Logic
import      Lvl
import      Structure.Function.Names as Names
open import Structure.Setoid
open import Type

private variable ℓₒ ℓₒ₁ ℓₒ₂ ℓₒ₃ ℓₗ ℓₗ₁ ℓₗ₂ ℓₗ₃ : Lvl.Level

module _
  {A : Type{ℓₒ₁}}
  {B : Type{ℓₒ₂}} ⦃ _ : Equiv{ℓₗ₂}(B) ⦄
  ⦃ _ : Equiv{ℓₗ₃}(A → B) ⦄
  (f g : A → B)
  where

  record FunctionExtensionalityOn : Stmt{ℓₒ₁ Lvl.⊔ ℓₗ₂ Lvl.⊔ ℓₗ₃} where
    constructor intro
    field proof : Names.FunctionExtensionalityOn(f)(g)
  functionExtensionalityOn = inst-fn FunctionExtensionalityOn.proof

  record FunctionApplicationOn : Stmt{ℓₒ₁ Lvl.⊔ ℓₗ₂ Lvl.⊔ ℓₗ₃} where
    constructor intro
    field proof : Names.FunctionApplicationOn(f)(g)
  functionApplicationOn = inst-fn FunctionApplicationOn.proof

module _ (A : Type{ℓₒ₁}) (B : Type{ℓₒ₂}) ⦃ _ : Equiv{ℓₗ₂}(B) ⦄ ⦃ _ : Equiv{ℓₗ₃}(A → B) ⦄ where
  FunctionExtensionality : Stmt
  FunctionExtensionality = ∀²(FunctionExtensionalityOn{ℓₒ₁}{ℓₒ₂}{ℓₗ₂}{ℓₗ₃}{A}{B})
  functionExtensionality : ⦃ funcExt : FunctionExtensionality ⦄ → Names.FunctionExtensionality(A)(B)
  functionExtensionality {f}{g} = functionExtensionalityOn f g

  FunctionApplication : Stmt
  FunctionApplication = ∀²(FunctionApplicationOn{ℓₒ₁}{ℓₒ₂}{ℓₗ₂}{ℓₗ₃}{A}{B})
  functionApplication : ⦃ funcApp : FunctionApplication ⦄ → Names.FunctionApplication(A)(B)
  functionApplication {f}{g} = functionApplicationOn f g

module _
  {A : Type{ℓₒ₁}}
  {B : A → Type{ℓₒ₂}} ⦃ _ : ∀{a} → Equiv{ℓₗ₂}(B(a)) ⦄
  ⦃ _ : Equiv{ℓₗ₃}((a : A) → B(a)) ⦄
  (f g : ((a : A) → B(a)))
  where

  record DependentFunctionExtensionalityOn : Stmt{ℓₒ₁ Lvl.⊔ ℓₗ₂ Lvl.⊔ ℓₗ₃} where
    constructor intro
    field proof : Names.DependentFunctionExtensionalityOn(f)(g)
  dependentFunctionExtensionalityOn = inst-fn DependentFunctionExtensionalityOn.proof

module _ (A : Type{ℓₒ₁}) (B : A → Type{ℓₒ₂}) ⦃ _ : ∀{a} → Equiv{ℓₗ₂}(B(a)) ⦄ ⦃ _ : Equiv{ℓₗ₃}((a : A) → B(a)) ⦄ where
  DependentFunctionExtensionality : Stmt
  DependentFunctionExtensionality = ∀²(DependentFunctionExtensionalityOn{ℓₒ₁}{ℓₒ₂}{ℓₗ₂}{ℓₗ₃}{A}{B})
  dependentFunctionExtensionality : ⦃ depFuncExt : DependentFunctionExtensionality ⦄ → Names.DependentFunctionExtensionality(A)(B)
  dependentFunctionExtensionality {f}{g} = dependentFunctionExtensionalityOn f g

module _
  {A : Type{ℓₒ₁}}
  {B : A → Type{ℓₒ₂}} ⦃ _ : ∀{a} → Equiv{ℓₗ₂}(B(a)) ⦄
  ⦃ _ : Equiv{ℓₗ₃}({a : A} → B(a)) ⦄
  (f g : ({a : A} → B(a)))
  where

  record DependentImplicitFunctionExtensionalityOn : Stmt{ℓₒ₁ Lvl.⊔ ℓₗ₂ Lvl.⊔ ℓₗ₃} where
    constructor intro
    field proof : Names.DependentImplicitFunctionExtensionalityOn(f)(g)
  dependentImplicitFunctionExtensionalityOn = inst-fn DependentImplicitFunctionExtensionalityOn.proof

module _ (A : Type{ℓₒ₁}) (B : A → Type{ℓₒ₂}) ⦃ _ : ∀{a} → Equiv{ℓₗ₂}(B(a)) ⦄ ⦃ _ : Equiv{ℓₗ₃}({a : A} → B(a)) ⦄ where
  DependentImplicitFunctionExtensionality : Stmt
  DependentImplicitFunctionExtensionality = ∀²(DependentImplicitFunctionExtensionalityOn{ℓₒ₁}{ℓₒ₂}{ℓₗ₂}{ℓₗ₃}{A}{B})
  dependentImplicitFunctionExtensionality : ⦃ depFuncExt : DependentImplicitFunctionExtensionality ⦄ → Names.DependentImplicitFunctionExtensionality(A)(B)
  dependentImplicitFunctionExtensionality {f}{g} = dependentImplicitFunctionExtensionalityOn f g

module _
  {A : Type{ℓₒ₁}}
  {B : A → Type{ℓₒ₂}} ⦃ _ : ∀{a} → Equiv{ℓₗ₂}(B(a)) ⦄
  ⦃ _ : Equiv{ℓₗ₃}(⦃ a : A ⦄ → B(a)) ⦄
  (f g : (⦃ a : A ⦄ → B(a)))
  where

  record DependentInstanceFunctionExtensionalityOn : Stmt{ℓₒ₁ Lvl.⊔ ℓₗ₂ Lvl.⊔ ℓₗ₃} where
    constructor intro
    field proof : Names.DependentInstanceFunctionExtensionalityOn(f)(g)
  dependentInstanceFunctionExtensionalityOn = inst-fn DependentInstanceFunctionExtensionalityOn.proof

module _ (A : Type{ℓₒ₁}) (B : A → Type{ℓₒ₂}) ⦃ _ : ∀{a} → Equiv{ℓₗ₂}(B(a)) ⦄ ⦃ _ : Equiv{ℓₗ₃}(⦃ a : A ⦄ → B(a)) ⦄ where
  DependentInstanceFunctionExtensionality : Stmt
  DependentInstanceFunctionExtensionality = ∀²(DependentInstanceFunctionExtensionalityOn{ℓₒ₁}{ℓₒ₂}{ℓₗ₂}{ℓₗ₃}{A}{B})
  dependentInstanceFunctionExtensionality : ⦃ depFuncExt : DependentInstanceFunctionExtensionality ⦄ → Names.DependentInstanceFunctionExtensionality(A)(B)
  dependentInstanceFunctionExtensionality {f}{g} = dependentInstanceFunctionExtensionalityOn f g


-- {-# OPTIONS --without-K #-}
module kripke where
open import common

infixl 2 _▻_
infixl 3 _‘’_
infixr 1 _‘→’_
infixr 1 _‘‘→’’_
infixr 1 _ww‘‘‘→’’’_
infixl 3 _‘’ₐ_
infixl 3 _w‘‘’’ₐ_
infixr 2 _‘∘’_
infixr 2 _‘×’_
infixr 2 _‘‘×’’_
infixr 2 _w‘‘×’’_

mutual
  data Context : Set where
    ε : Context
    _▻_ : (Γ : Context) → Type Γ → Context

  data Type : Context → Set where
    W : ∀ {Γ A} → Type Γ → Type (Γ ▻ A)
    W1 : ∀ {Γ A B} → Type (Γ ▻ B) → Type (Γ ▻ A ▻ (W {Γ = Γ} {A = A} B))
    _‘’_ : ∀ {Γ A} → Type (Γ ▻ A) → Term {Γ} A → Type Γ
    ‘Type’ : ∀ Γ → Type Γ
    ‘Term’ : ∀ {Γ} → Type (Γ ▻ ‘Type’ Γ)
    _‘→’_ : ∀ {Γ} → Type Γ → Type Γ → Type Γ
    _‘×’_ : ∀ {Γ} → Type Γ → Type Γ → Type Γ
    Quine : ∀ {Γ} → Type (Γ ▻ ‘Type’ Γ) → Type Γ
    ‘⊤’ : ∀ {Γ} → Type Γ
    ‘⊥’ : ∀ {Γ} → Type Γ

  data Term : {Γ : Context} → Type Γ → Set where
    ⌜_⌝ : ∀ {Γ} → Type Γ → Term {Γ} (‘Type’ Γ)
    ⌜_⌝t : ∀ {Γ T} → Term {Γ} T → Term {Γ} (‘Term’ ‘’ ⌜ T ⌝)
    ‘⌜‘VAR₀’⌝t’ : ∀ {Γ T} → Term {Γ ▻ ‘Term’ ‘’ ⌜ T ⌝} (W (‘Term’ ‘’ ⌜ ‘Term’ ‘’ ⌜ T ⌝ ⌝))
    ‘⌜‘VAR₀’⌝’ : ∀ {Γ} → Term {Γ ▻ ‘Type’ Γ} (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝))
    ‘λ∙’ : ∀ {Γ A B} → Term {Γ ▻ A} (W B) → Term {Γ} (A ‘→’ B)
    ‘VAR₀’ : ∀ {Γ T} → Term {Γ ▻ T} (W T)
    _‘’ₐ_ : ∀ {Γ A B} → Term {Γ} (A ‘→’ B) → Term {Γ} A → Term {Γ} B
    ‘‘×'’’ : ∀ {Γ} → Term {Γ} (‘Type’ Γ ‘→’ ‘Type’ Γ ‘→’ ‘Type’ Γ)
    quine→ : ∀ {Γ φ} → Term {Γ} (Quine φ        ‘→’ φ ‘’ ⌜ Quine φ ⌝)
    quine← : ∀ {Γ φ} → Term {Γ} (φ ‘’ ⌜ Quine φ ⌝ ‘→’ Quine φ)
    ‘tt’ : ∀ {Γ} → Term {Γ} ‘⊤’
    SW : ∀ {Γ X A} {a : Term A} → Term {Γ} (W X ‘’ a) → Term X
    →SW1SV→W : ∀ {Γ T X A B} {x : Term X}
      → Term {Γ} (T ‘→’ (W1 A ‘’ ‘VAR₀’ ‘→’ W B) ‘’ x)
      → Term {Γ} (T ‘→’ A ‘’ x ‘→’ B)
    ←SW1SV→W : ∀ {Γ T X A B} {x : Term X}
      → Term {Γ} ((W1 A ‘’ ‘VAR₀’ ‘→’ W B) ‘’ x ‘→’ T)
      → Term {Γ} ((A ‘’ x ‘→’ B) ‘→’ T)
    →SW1SV→SW1SV→W : ∀ {Γ T X A B} {x : Term X}
      → Term {Γ} (T ‘→’ (W1 A ‘’ ‘VAR₀’ ‘→’ W1 A ‘’ ‘VAR₀’ ‘→’ W B) ‘’ x)
      → Term {Γ} (T ‘→’ A ‘’ x ‘→’ A ‘’ x ‘→’ B)
    ←SW1SV→SW1SV→W : ∀ {Γ T X A B} {x : Term X}
      → Term {Γ} ((W1 A ‘’ ‘VAR₀’ ‘→’ W1 A ‘’ ‘VAR₀’ ‘→’ W B) ‘’ x ‘→’ T)
      → Term {Γ} ((A ‘’ x ‘→’ A ‘’ x ‘→’ B) ‘→’ T)
    w : ∀ {Γ A T} → Term {Γ} A → Term {Γ ▻ T} (W A)
    w→ : ∀ {Γ A B X} → Term {Γ ▻ X} (W (A ‘→’ B)) → Term {Γ ▻ X} (W A ‘→’ W B)
    →w : ∀ {Γ A B X} → Term {Γ ▻ X} (W A ‘→’ W B) → Term {Γ ▻ X} (W (A ‘→’ B))
    ww→ : ∀ {Γ A B X Y} → Term {Γ ▻ X ▻ Y} (W (W (A ‘→’ B))) → Term {Γ ▻ X ▻ Y} (W (W A) ‘→’ W (W B))
    →ww : ∀ {Γ A B X Y} → Term {Γ ▻ X ▻ Y} (W (W A) ‘→’ W (W B)) → Term {Γ ▻ X ▻ Y} (W (W (A ‘→’ B)))
    _‘∘’_ : ∀ {Γ A B C} → Term {Γ} (B ‘→’ C) → Term {Γ} (A ‘→’ B) → Term {Γ} (A ‘→’ C)
    _w‘‘’’ₐ_ : ∀ {Γ A B T} → Term {Γ ▻ T} (W (‘Term’ ‘’ ⌜ A ‘→’ B ⌝)) → Term {Γ ▻ T} (W (‘Term’ ‘’ ⌜ A ⌝)) → Term {Γ ▻ T} (W (‘Term’ ‘’ ⌜ B ⌝))
    ‘‘’ₐ’ : ∀ {Γ A B} → Term {Γ} (‘Term’ ‘’ ⌜ A ‘→’ B ⌝ ‘→’ ‘Term’ ‘’ ⌜ A ⌝ ‘→’ ‘Term’ ‘’ ⌜ B ⌝)
    -- _w‘‘’’_ : ∀ {Γ A B T} → Term {Γ ▻ T} (‘Type’ (Γ ▻ T)) → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ T ⌝))) → Term {Γ ▻ A ▻ B} (W (W (‘Type’ Γ)))
    ‘‘□’’ : ∀ {Γ A B} → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝))) → Term {Γ ▻ A ▻ B} (W (W (‘Type’ Γ)))
    -- ‘‘’’' : ∀ {Γ A} → Term {Γ ▻ A} (‘Type’ (Γ ▻ A) ‘→’ W (‘Term’ ‘’ ⌜ A ⌝) ‘→’ W (‘Type’ Γ))
    _‘‘→’’_ : ∀ {Γ} → Term {Γ} (‘Type’ Γ) → Term {Γ} (‘Type’ Γ) → Term {Γ} (‘Type’ Γ)
    _ww‘‘‘→’’’_ : ∀ {Γ A B} → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝))) → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝))) → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝)))
    _ww‘‘‘×’’’_ : ∀ {Γ A B} → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝))) → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝))) → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝)))

□ : Type ε → Set _
□ = Term {ε}

‘□’ : ∀ {Γ} → Type Γ → Type Γ
‘□’ T = ‘Term’ ‘’ ⌜ T ⌝

_‘‘×’’_ : ∀ {Γ} → Term {Γ} (‘Type’ Γ) → Term {Γ} (‘Type’ Γ) → Term {Γ} (‘Type’ Γ)
A ‘‘×’’ B = ‘‘×'’’ ‘’ₐ A ‘’ₐ B

max-level : Level
max-level = lzero

mutual
  Context⇓ : (Γ : Context) → Set (lsuc max-level)
  Context⇓ ε = ⊤
  Context⇓ (Γ ▻ T) = Σ (Context⇓ Γ) (Type⇓ {Γ} T)

  Type⇓ : {Γ : Context} → Type Γ → Context⇓ Γ → Set max-level
  Type⇓ (W T) Γ⇓ = Type⇓ T (Σ.proj₁ Γ⇓)
  Type⇓ (W1 T) Γ⇓ = Type⇓ T ((Σ.proj₁ (Σ.proj₁ Γ⇓)) , (Σ.proj₂ Γ⇓))
  Type⇓ (T ‘’ x) Γ⇓ = Type⇓ T (Γ⇓ , Term⇓ x Γ⇓)
  Type⇓ (‘Type’ Γ) Γ⇓ = Lifted (Type Γ)
  Type⇓ ‘Term’ Γ⇓ = Lifted (Term (lower (Σ.proj₂ Γ⇓)))
  Type⇓ (A ‘→’ B) Γ⇓ = Type⇓ A Γ⇓ → Type⇓ B Γ⇓
  Type⇓ (A ‘×’ B) Γ⇓ = Type⇓ A Γ⇓ × Type⇓ B Γ⇓
  Type⇓ ‘⊤’ Γ⇓ = ⊤
  Type⇓ ‘⊥’ Γ⇓ = ⊥
  Type⇓ (Quine φ) Γ⇓ = Type⇓ φ (Γ⇓ , (lift (Quine φ)))

  Term⇓ : ∀ {Γ : Context} {T : Type Γ} → Term T → (Γ⇓ : Context⇓ Γ) → Type⇓ T Γ⇓
  Term⇓ ⌜ x ⌝ Γ⇓ = lift x
  Term⇓ ⌜ x ⌝t Γ⇓ = lift x
  Term⇓ ‘⌜‘VAR₀’⌝t’ Γ⇓ = lift ⌜ (lower (Σ.proj₂ Γ⇓)) ⌝t
  Term⇓ ‘⌜‘VAR₀’⌝’ Γ⇓ = lift ⌜ (lower (Σ.proj₂ Γ⇓)) ⌝
  Term⇓ (f ‘’ₐ x) Γ⇓ = Term⇓ f Γ⇓ (Term⇓ x Γ⇓)
  Term⇓ ‘tt’ Γ⇓ = tt
  Term⇓ (quine→ {φ}) Γ⇓ x = x
  Term⇓ (quine← {φ}) Γ⇓ x = x
  Term⇓ (‘λ∙’ f) Γ⇓ x = Term⇓ f (Γ⇓ , x)
  Term⇓ ‘VAR₀’ Γ⇓ = Σ.proj₂ Γ⇓
  Term⇓ (SW t) = Term⇓ t
  Term⇓ (←SW1SV→W f) = Term⇓ f
  Term⇓ (→SW1SV→W f) = Term⇓ f
  Term⇓ (←SW1SV→SW1SV→W f) = Term⇓ f
  Term⇓ (→SW1SV→SW1SV→W f) = Term⇓ f
  Term⇓ (w x) Γ⇓ = Term⇓ x (Σ.proj₁ Γ⇓)
  Term⇓ (w→ f) Γ⇓ = Term⇓ f Γ⇓
  Term⇓ (→w f) Γ⇓ = Term⇓ f Γ⇓
  Term⇓ (ww→ f) Γ⇓ = Term⇓ f Γ⇓
  Term⇓ (→ww f) Γ⇓ = Term⇓ f Γ⇓
  Term⇓ ‘‘×'’’ Γ⇓ A B = lift (lower A ‘×’ lower B)
  Term⇓ (g ‘∘’ f) Γ⇓ x = Term⇓ g Γ⇓ (Term⇓ f Γ⇓ x)
  Term⇓ (f w‘‘’’ₐ x) Γ⇓ = lift (lower (Term⇓ f Γ⇓) ‘’ₐ lower (Term⇓ x Γ⇓))
  Term⇓ ‘‘’ₐ’ Γ⇓ f x = lift (lower f ‘’ₐ lower x)
  -- Term⇓ (f w‘‘’’ x) Γ⇓ = lift {!!} --(lower (Term⇓ f Γ⇓) ‘’ lower (Term⇓ x Γ⇓))
  Term⇓ (‘‘□’’ {Γ} T) Γ⇓ = lift (‘Term’ ‘’ lower (Term⇓ T Γ⇓))
  Term⇓ (A ‘‘→’’ B) Γ⇓ = lift ((lower (Term⇓ A Γ⇓)) ‘→’ (lower (Term⇓ B Γ⇓)))
  Term⇓ (A ww‘‘‘→’’’ B) Γ⇓ = lift ((lower (Term⇓ A Γ⇓)) ‘‘→’’ (lower (Term⇓ B Γ⇓)))
  Term⇓ (A ww‘‘‘×’’’ B) Γ⇓ = lift ((lower (Term⇓ A Γ⇓)) ‘‘×’’ (lower (Term⇓ B Γ⇓)))

module inner (‘X’ : Type ε) (‘f’ : Term {ε} (‘□’ ‘X’ ‘→’ ‘X’)) where
  ‘H’ : Type ε
  ‘H’ = Quine (W1 ‘Term’ ‘’ ‘VAR₀’ ‘→’ W ‘X’)

  ‘toH’ : □ ((‘□’ ‘H’ ‘→’ ‘X’) ‘→’ ‘H’)
  ‘toH’ = ←SW1SV→W quine←

  ‘fromH’ : □ (‘H’ ‘→’ (‘□’ ‘H’ ‘→’ ‘X’))
  ‘fromH’ = →SW1SV→W quine→

  ‘□‘H’→□‘X’’ : □ (‘□’ ‘H’ ‘→’ ‘□’ ‘X’)
  ‘□‘H’→□‘X’’ = ‘λ∙’ (w ⌜ ‘fromH’ ⌝t w‘‘’’ₐ ‘VAR₀’ w‘‘’’ₐ ‘⌜‘VAR₀’⌝t’)

  ‘h’ : Term ‘H’
  ‘h’ = ‘toH’ ‘’ₐ (‘f’ ‘∘’ ‘□‘H’→□‘X’’)

  Lӧb : □ ‘X’
  Lӧb = ‘fromH’ ‘’ₐ ‘h’ ‘’ₐ ⌜ ‘h’ ⌝t

Lӧb : ∀ {X} → Term {ε} (‘□’ X ‘→’ X) → Term {ε} X
Lӧb {X} f = inner.Lӧb X f

⌞_⌟ : Type ε → Set _
⌞ T ⌟ = Type⇓ T tt

‘¬’_ : ∀ {Γ} → Type Γ → Type Γ
‘¬’ T = T ‘→’ ‘⊥’

_w‘‘×’’_ : ∀ {Γ X} → Term {Γ ▻ X} (W (‘Type’ Γ)) → Term {Γ ▻ X} (W (‘Type’ Γ)) → Term {Γ ▻ X} (W (‘Type’ Γ))
A w‘‘×’’ B = w→ (w→ (w ‘‘×'’’) ‘’ₐ A) ‘’ₐ B

lӧb : ∀ {‘X’} → □ (‘□’ ‘X’ ‘→’ ‘X’) → ⌞ ‘X’ ⌟
lӧb f = Term⇓ (Lӧb f) tt

incompleteness : ¬ □ (‘¬’ (‘□’ ‘⊥’))
incompleteness = lӧb

soundness : ¬ □ ‘⊥’
soundness x = Term⇓ x tt

non-emptyness : Σ (Type ε) (λ T → □ T)
non-emptyness = ‘⊤’ , ‘tt’

module helpers where
  Wₕ : ∀ {Γ A} → Type Γ → Type (Γ ▻ A)
  Wₕ ‘⊤’ = ‘⊤’
  Wₕ ‘⊥’ = ‘⊥’
  Wₕ (T ‘→’ T₂) = Wₕ T ‘→’ Wₕ T₂
  Wₕ (T ‘×’ T₂) = Wₕ T ‘×’ Wₕ T₂
  Wₕ (W T₂) = W (Wₕ T₂)
  Wₕ T = W T

  _‘’ₕ_ : ∀ {Γ A} → Type (Γ ▻ A) → Term A → Type Γ
  ‘⊤’ ‘’ₕ x₁ = ‘⊤’
  ‘⊥’ ‘’ₕ x₁ = ‘⊥’
  W f ‘’ₕ x₁ = f
  ‘Term’ ‘’ₕ ⌜ ‘⊤’ ⌝ = ‘⊤’
  (f ‘→’ f₁) ‘’ₕ x₁ = (f ‘’ₕ x₁) ‘→’ (f₁ ‘’ₕ x₁)
  (f ‘×’ f₁) ‘’ₕ x₁ = (f ‘’ₕ x₁) ‘×’ (f₁ ‘’ₕ x₁)
  f ‘’ₕ x = f ‘’ x

  _‘→’ₕ_ : ∀ {Γ} → Type Γ → Type Γ → Type Γ
  ‘⊤’ ‘→’ₕ B = B
  ‘⊥’ ‘→’ₕ B = ‘⊤’
  A ‘→’ₕ ‘⊤’ = ‘⊤’
  A ‘→’ₕ B = A ‘→’ B

  _‘×’ₕ_ : ∀ {Γ} → Type Γ → Type Γ → Type Γ
  ‘⊤’ ‘×’ₕ B = B
  ‘⊥’ ‘×’ₕ B = ‘⊥’
  A ‘×’ₕ ‘⊤’ = A
  A ‘×’ₕ ‘⊥’ = ‘⊥’
  A ‘×’ₕ B = A ‘×’ B

open helpers

mutual
  simplify-type : ∀ {Γ} → Type Γ → Type Γ
  simplify-type ‘⊤’ = ‘⊤’
  simplify-type ‘⊥’ = ‘⊥’
  simplify-type (T ‘→’ T₁) = simplify-type T ‘→’ₕ simplify-type T₁
  simplify-type (T ‘×’ T₁) = simplify-type T ‘×’ₕ simplify-type T₁
  simplify-type (T₁ ‘’ x) = simplify-type T₁ ‘’ₕ simplify-term x
  simplify-type (W T₁) = Wₕ (simplify-type T₁)
  simplify-type (W1 T₂) = W1ₕ (simplify-type T₂)
    where W1ₕ : ∀ {Γ A B} → Type (Γ ▻ A) → Type (Γ ▻ B ▻ W A)
          W1ₕ ‘⊤’ = ‘⊤’
          W1ₕ ‘⊥’ = ‘⊥’
          W1ₕ (T ‘→’ T₂) = W1ₕ T ‘→’ W1ₕ T₂
          W1ₕ (T ‘×’ T₂) = W1ₕ T ‘×’ W1ₕ T₂
          W1ₕ (W T₂) = W (Wₕ T₂)
          W1ₕ (W1 T₂) = W1 (W1ₕ T₂)
          W1ₕ T = W1 T
  simplify-type (‘Type’ Γ) = ‘Type’ Γ
  simplify-type ‘Term’ = ‘Term’
  simplify-type (Quine T) = Quine (simplify-type T)

  simplify-term : ∀ {Γ T} → Term {Γ} T → Term T
  simplify-term ⌜ x ⌝ = ⌜ simplify-type x ⌝
  simplify-term ⌜ t ⌝t = ⌜ simplify-term t ⌝t
  simplify-term ‘⌜‘VAR₀’⌝t’ = ‘⌜‘VAR₀’⌝t’
  simplify-term ‘⌜‘VAR₀’⌝’ = ‘⌜‘VAR₀’⌝’
  simplify-term (‘λ∙’ t) = ‘λ∙’ (simplify-term t)
  simplify-term ‘VAR₀’ = ‘VAR₀’
  simplify-term (t ‘’ₐ t₁) = simplify-term t ‘’ₐₕ simplify-term t₁
    where _‘’ₐₕ_ : ∀ {Γ A T} → Term {Γ} (A ‘→’ T) → Term A → Term T
          ‘λ∙’ ‘⌜‘VAR₀’⌝t’ ‘’ₐₕ x = ⌜ x ⌝t
          ‘λ∙’ ‘⌜‘VAR₀’⌝’ ‘’ₐₕ x = ⌜ x ⌝t
          ‘λ∙’ ‘VAR₀’ ‘’ₐₕ x = x
          ‘λ∙’ (f ‘’ₐ f₁) ‘’ₐₕ x = ‘λ∙’ (f ‘’ₐₕ f₁) ‘’ₐ x
          ‘λ∙’ (w f) ‘’ₐₕ x = f
          (f ‘’ₐ f₁) ‘’ₐₕ x = (f ‘’ₐₕ f₁) ‘’ₐ x
          (f ‘∘’ f₁) ‘’ₐₕ x = f ‘’ₐₕ (f₁ ‘’ₐₕ x)
          f ‘’ₐₕ x = f ‘’ₐ x
  simplify-term ‘‘×'’’ = ‘‘×'’’
  simplify-term quine→ = quine→
  simplify-term quine← = quine←
  simplify-term ‘tt’ = ‘tt’
  simplify-term (SW t₁) = SW (simplify-term t₁)
  simplify-term (→SW1SV→W t₁) = →SW1SV→W (simplify-term t₁)
  simplify-term (←SW1SV→W t₁) = ←SW1SV→W (simplify-term t₁)
  simplify-term (→SW1SV→SW1SV→W t₁) = →SW1SV→SW1SV→W (simplify-term t₁)
  simplify-term (←SW1SV→SW1SV→W t₁) = ←SW1SV→SW1SV→W (simplify-term t₁)
  simplify-term (w t) = w (simplify-term t)
  simplify-term (w→ t) = w→ (simplify-term t)
  simplify-term (→w t) = →w (simplify-term t)
  simplify-term (ww→ t) = ww→ (simplify-term t)
  simplify-term (→ww t) = →ww (simplify-term t)
  simplify-term (t ‘∘’ t₁) = simplify-term t ‘∘’ simplify-term t₁
  simplify-term (t w‘‘’’ₐ t₁) = simplify-term t w‘‘’’ₐ simplify-term t₁
  simplify-term ‘‘’ₐ’ = ‘‘’ₐ’
  simplify-term (‘‘□’’ t) = ‘‘□’’ (simplify-term t)
  simplify-term (t ‘‘→’’ t₁) = simplify-term t ‘‘→’’ simplify-term t₁
  simplify-term (t ww‘‘‘→’’’ t₁) = simplify-term t ww‘‘‘→’’’ simplify-term t₁
  simplify-term (t ww‘‘‘×’’’ t₁) = simplify-term t ww‘‘‘×’’’ simplify-term t₁
{-
mutual
  simplify-type⇓→ : ∀ {Γ T Γ⇓} → Type⇓ {Γ} T Γ⇓ → Type⇓ {Γ} (simplify-type T) Γ⇓
  simplify-type⇓→ {T = T ‘→’ T₁} T⇓ = {!!}
  simplify-type⇓→ {T = W T₁} T⇓ = {!!}
  simplify-type⇓→ {T = W1 T₂} T⇓ = {!!}
  simplify-type⇓→ {T = T₁ ‘’ x} T⇓ = {!!}
  simplify-type⇓→ {T = ‘Type’ ._} T⇓ = {!!}
  simplify-type⇓→ {T = ‘Term’} T⇓ = {!!}
  simplify-type⇓→ {T = T ‘×’ T₁} T⇓ = {!!}
  simplify-type⇓→ {T = Quine T} T⇓ = {!!}
  simplify-type⇓→ {T = ‘⊤’} T⇓ = tt
  simplify-type⇓→ {T = ‘⊥’} T⇓ = T⇓

  simplify-type⇓← : ∀ {Γ T Γ⇓} → Type⇓ {Γ} (simplify-type T) Γ⇓ → Type⇓ {Γ} T Γ⇓
  simplify-type⇓← {T = W T₁} T⇓ = {!!}
  simplify-type⇓← {T = W1 T₂} T⇓ = {!!}
  simplify-type⇓← {T = T₁ ‘’ x} T⇓ = {!!}
  simplify-type⇓← {T = ‘Type’ ._} T⇓ = {!!}
  simplify-type⇓← {T = ‘Term’} T⇓ = {!!}
  simplify-type⇓← {T = T ‘→’ T₁} T⇓ x = {!!}
  simplify-type⇓← {Γ} {T ‘×’ T₁} {Γ⇓} T⇓ = helper {Γ} {simplify-type T} {simplify-type T₁} {T} {T₁} {Γ⇓} (simplify-type⇓← {T = T}) (simplify-type⇓← {T = T₁}) T⇓
    where helper : ∀ {Γ A B A' B'} {Γ⇓ : Context⇓ Γ}
                 → (Type⇓ A Γ⇓ → Type⇓ A' Γ⇓)
                 → (Type⇓ B Γ⇓ → Type⇓ B' Γ⇓)
                 → Type⇓ (A ‘×’ₕ B) Γ⇓
                 → Type⇓ (A' ‘×’ B') Γ⇓
          helper {A = ‘⊤’} f g x = f tt , g x
          helper {A = ‘⊥’} f g ()
          helper {A = W A₁} {‘⊤’} f g x = f x , g tt
          helper {A = W1 A₂} {‘⊤’} f g x = f x , g tt
          helper {A = A₁ ‘’ x} {‘⊤’} f g x₁ = f x₁ , g tt
          helper {A = ‘Type’ ._} {‘⊤’} f g x = f x , g tt
          helper {A = ‘Term’} {‘⊤’} f g x = f x , g tt
          helper {A = A ‘→’ A₁} {‘⊤’} f g x = f x , g tt
          helper {A = A ‘×’ A₁} {‘⊤’} f g x = f x , g tt
          helper {A = Quine A} {‘⊤’} f g x = f x , g tt
          helper {A = W A₁} {‘⊥’} {Γ⇓ = proj₁ , proj₂} f g ()
          helper {A = W1 A₂} {‘⊥’} {Γ⇓ = proj₁ , proj₂ , proj₃} f g ()
          helper {A = A₁ ‘’ x} {‘⊥’} f g ()
          helper {A = ‘Type’ ._} {‘⊥’} f g ()
          helper {A = ‘Term’} {‘⊥’} {Γ⇓ = proj₁ , proj₂} f g ()
          helper {A = A ‘→’ A₁} {‘⊥’} f g ()
          helper {A = A ‘×’ A₁} {‘⊥’} f g ()
          helper {A = Quine A} {‘⊥’} f g ()
          helper {A = W A₁} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = f (Σ.proj₁ x) , g (Σ.proj₂ x)
          helper {A = W1 A₂} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = f (Σ.proj₁ x) , g (Σ.proj₂ x)
          helper {A = A₂ ‘’ _} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = {!f (Σ.proj₁ x) , g (Σ.proj₂ x)!}
          helper {A = ‘Type’ ._} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = f (Σ.proj₁ x) , g (Σ.proj₂ x)
          helper {A = ‘Term’} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = f (Σ.proj₁ x) , g (Σ.proj₂ x)
          helper {A = A₁ ‘→’ A₂} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = f (Σ.proj₁ x) , g (Σ.proj₂ x)
          helper {A = A₁ ‘×’ A₂} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = f (Σ.proj₁ x) , g (Σ.proj₂ x)
          helper {A = Quine A₁} {W B₁} {Γ⇓ = proj₁ , proj₂} f g x = f (Σ.proj₁ x) , g (Σ.proj₂ x)
          helper {B = W1 B₂} f g x = {!!}
          helper {B = B₁ ‘’ x} f g x₁ = {!!}
          helper {B = ‘Type’ ._} f g x = {!!}
          helper {B = ‘Term’} f g x = {!!}
          helper {B = B ‘→’ B₁} f g x = {!!}
          helper {B = B ‘×’ B₁} f g x = {!!}
          helper {B = Quine B} f g x = {!!} {-
          helper {A = W A₁} f g x = {!!}
          helper {A = W1 A₂} f g x = {!!}
          helper {A = A₁ ‘’ x} f g x₁ = {!!}
          helper {A = ‘Type’ ._} f g x = {!!}
          helper {A = ‘Term’} f g x = {!!}
          helper {A = A ‘→’ A₁} f g x = {!!}
          helper {A = A ‘×’ A₁} f g x = {!!}
          helper {A = Quine A} f g x = {!!} -}
  simplify-type⇓← {T = Quine T} T⇓ = {!!}
  simplify-type⇓← {T = ‘⊤’} T⇓ = tt
  simplify-type⇓← {T = ‘⊥’} T⇓ = T⇓
-}

module modal-fixpoint where
  context-to-term : Context → Set
  context-to-term ε = ⊤
  context-to-term (Γ ▻ x) = Σ (context-to-term Γ) (λ _ → Term x)

  context-to-term⇓ : ∀ {Γ} → context-to-term Γ → Context⇓ Γ
  context-to-term⇓ {ε} v = tt
  context-to-term⇓ {Γ ▻ x} v = (context-to-term⇓ (Σ.proj₁ v)) , (Term⇓ (Σ.proj₂ v) (context-to-term⇓ (Σ.proj₁ v)))

  Type-in : ∀ {Γ} → Type Γ → context-to-term Γ → Type ε
  Type-in {ε} T v = T
  Type-in (T ‘→’ T₁) v = (Type-in T v) ‘→’ (Type-in T₁ v)
  Type-in ‘⊤’ v = ‘⊤’
  Type-in ‘⊥’ v = ‘⊥’
  Type-in {Γ ▻ x} T v = Type-in (T ‘’ Σ.proj₂ v) (Σ.proj₁ v)

  postulate hold : ∀ {Γ} → ℕ → Type Γ → Type Γ
  postulate hold-t : ∀ {Γ T} → ℕ → Term {Γ} T → Term T

  helper-ikf : ∀ {Γ A} world (T₁ : Type (Γ ▻ A)) (x : Term A) → Type Γ
  helper-ikf zero ‘Term’ x₁ = ‘⊤’
  helper-ikf world f (x₁ ‘‘→’’ x₂) = helper-ikf world f x₁ ‘→’ helper-ikf world f x₂
  helper-ikf (suc world) ‘Term’ ⌜ x₁ ⌝ = x₁
  helper-ikf (suc world) ‘Term’ (x₁ ‘’ₐ x₂) = hold (suc world) (‘Term’ ‘’ (x₁ ‘’ₐ x₂))
  helper-ikf (suc world) ‘Term’ (SW x₂) = hold (suc world) (‘Term’ ‘’ SW x₂)
  helper-ikf world (W T₂) x₁ = T₂
  helper-ikf world (W1 T₄) x₁ = hold world (W1 T₄ ‘’ x₁)
  helper-ikf world (T₃ ‘’ x₁) x₂ = hold world (T₃ ‘’ x₁ ‘’ x₂)
  helper-ikf world (‘Type’ ._) x₁ = hold world (‘Type’ _ ‘’ x₁)
  helper-ikf world (T₂ ‘→’ T₃) x₁ = helper-ikf world T₂ x₁ ‘→’ helper-ikf world T₃ x₁
  helper-ikf world (T₂ ‘×’ T₃) x₁ = helper-ikf world T₂ x₁ ‘×’ helper-ikf world T₃ x₁
  helper-ikf world (Quine T₂) x₁ = hold world (Quine T₂ ‘’ x₁)
  helper-ikf world ‘⊤’ x₁ = ‘⊤’
  helper-ikf world ‘⊥’ x₁ = ‘⊥’

  mutual
{-    _‘’ₐₕ_ : ∀ {Γ A B} {world} (f : Term {Γ} (A ‘→’ B)) (x : Term A) → Term B
    ‘λ∙’ ‘⌜‘VAR₀’⌝t’ ‘’ₐₕ x₂ = ⌜ x₂ ⌝t
    ‘λ∙’ ‘⌜‘VAR₀’⌝’ ‘’ₐₕ x₂ = ⌜ x₂ ⌝t
    ‘λ∙’ ‘VAR₀’ ‘’ₐₕ x₂ = x₂
    ‘λ∙’ (f ‘’ₐ f₁) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (SW f₁) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (w f) ‘’ₐₕ x₂ = f
    ‘λ∙’ (→w (‘λ∙’ ‘VAR₀’)) ‘’ₐₕ x₂ = ‘λ∙’ ‘VAR₀’
    ‘λ∙’ (→w (‘λ∙’ (f ‘’ₐ f₁))) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (‘λ∙’ (SW f₁))) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (‘λ∙’ (w f))) ‘’ₐₕ x₂ = ‘λ∙’ (w (‘λ∙’ f ‘’ₐₕ x₂))
    ‘λ∙’ (→w (‘λ∙’ (→ww f))) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (‘λ∙’ (‘‘□’’ f))) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (‘λ∙’ (f ww‘‘‘→’’’ f₁))) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (‘λ∙’ (f ww‘‘‘×’’’ f₁))) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (f ‘’ₐ f₁)) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (SW f₁)) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (w→ f)) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (ww→ f)) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→w (f ‘∘’ f₁)) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (→ww f) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (f w‘‘’’ₐ f₁) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (‘‘□’’ f) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (f ww‘‘‘→’’’ f₁) ‘’ₐₕ x₂ = {!!}
    ‘λ∙’ (f ww‘‘‘×’’’ f₁) ‘’ₐₕ x₂ = {!!}
    _‘’ₐₕ_ {world = world} (f ‘’ₐ f₁) x₂ = hold-t world ((_‘’ₐₕ_ {world = world} f f₁) ‘’ₐ x₂)
    _‘’ₐₕ_ {world = world} ‘‘×'’’ x₂ = {!!}
    _‘’ₐₕ_ {world = world} quine→ x₂ = {!!}
    _‘’ₐₕ_ {world = world} quine← x₂ = {!!}
    _‘’ₐₕ_ {world = world} (SW f₁) x₂ = {!!}
    _‘’ₐₕ_ {world = world} (→SW1SV→W f₁) x₂ = {!!}
    _‘’ₐₕ_ {world = world} (←SW1SV→W f₁) x₂ = {!!}
    →SW1SV→SW1SV→W (‘λ∙’ f₁) ‘’ₐₕ x₂ = {!!}
    →SW1SV→SW1SV→W (f₁ ‘’ₐ f₂) ‘’ₐₕ x₂ = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ⌜ x ⌝) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ⌜ x₃ ⌝t) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘⌜‘VAR₀’⌝t’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘⌜‘VAR₀’⌝’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ ‘⌜‘VAR₀’⌝t’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ ‘⌜‘VAR₀’⌝’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ ‘VAR₀’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (x₃ ‘’ₐ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (SW x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (w x₃)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ ‘VAR₀’))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (x₃ ‘’ₐ x₄)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (SW x₄)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w ‘⌜‘VAR₀’⌝t’)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w ‘⌜‘VAR₀’⌝’)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w ‘VAR₀’)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (x₃ ‘’ₐ x₄))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (SW x₄))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (‘λ∙’ x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ x₃ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (SW x₃ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→W (‘λ∙’ x₃) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→W (x₃ ‘’ₐ x₄) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→W (SW x₄) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→W (x₃ ‘∘’ x₄) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→SW1SV→W (‘λ∙’ x₃) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→SW1SV→W (x₃ ‘’ₐ x₄) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→SW1SV→W quine← ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x ⌝))))) = ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x ⌝))))
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→SW1SV→W (SW x₄) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→SW1SV→W (x₃ ‘∘’ x₄) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₁ ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ ((x₂ ‘∘’ x₃) ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x ⌝))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ⌜ x₃ ⌝t))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ‘⌜‘VAR₀’⌝t’))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ‘⌜‘VAR₀’⌝’))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (‘λ∙’ x₃)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ‘VAR₀’))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (x₃ ‘’ₐ x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ‘‘×'’’))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w quine→))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w quine←))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ‘tt’))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (SW x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (→SW1SV→W x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (←SW1SV→W x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (→SW1SV→SW1SV→W x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (←SW1SV→SW1SV→W x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (w x₃)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (w→ x₃)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (→w x₃)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (ww→ x₃)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (→ww x₃)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (x₃ ‘∘’ x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (x₃ w‘‘’’ₐ x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w ‘‘’ₐ’))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (‘‘□’’ x₃)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (x₃ ‘‘→’’ x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (x₃ ww‘‘‘→’’’ x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (w (x₃ ww‘‘‘×’’’ x₄)))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (→w x₃))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (→ww x₃))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (x₃ w‘‘’’ₐ x₄))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (‘‘□’’ x₃))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (x₃ ww‘‘‘→’’’ x₄))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (w (x₃ ww‘‘‘×’’’ x₄))))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (→ww x₃)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (‘‘□’’ x₃)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (x₃ ww‘‘‘→’’’ x₄)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (‘λ∙’ (x₃ ww‘‘‘×’’’ x₄)))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (x₃ ‘’ₐ x₄))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (SW x₄))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (w→ x₃))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (ww→ x₃))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→w (x₃ ‘∘’ x₄))) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (→ww x₃)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (x₃ w‘‘’’ₐ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (‘‘□’’ x₃)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (x₃ ww‘‘‘→’’’ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘λ∙’ (x₃ ww‘‘‘×’’’ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘VAR₀’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ (x₃ ‘’ₐ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘‘×'’’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ quine→) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ quine←) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘tt’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ SW x₄) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ →SW1SV→W x₄) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ←SW1SV→W x₄) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ →SW1SV→SW1SV→W x₄) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ←SW1SV→SW1SV→W x₄) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ w x₃) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ w→ x₃) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ →w x₃) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ww→ x₃) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ →ww x₃) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ (x₃ ‘∘’ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ (x₃ w‘‘’’ₐ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘‘’ₐ’) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ ‘‘□’’ x₃) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ (x₃ ‘‘→’’ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ (x₃ ww‘‘‘→’’’ x₄)) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (x₂ ‘’ₐ x₃ ww‘‘‘×’’’ x₄) = {!!}
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ SW x₃ = {!!}
    →SW1SV→SW1SV→W (SW f₂) ‘’ₐₕ x₂ = {!!}
    →SW1SV→SW1SV→W (←SW1SV→W f₂) ‘’ₐₕ x₂ = {!!}
    →SW1SV→SW1SV→W (←SW1SV→SW1SV→W f₂) ‘’ₐₕ x₂ = {!!}
    →SW1SV→SW1SV→W (f₁ ‘∘’ f₂) ‘’ₐₕ x₂ = {!!}
    ←SW1SV→SW1SV→W (‘λ∙’ f₁) ‘’ₐₕ x₂ = {!!}
    ←SW1SV→SW1SV→W (f₁ ‘’ₐ f₂) ‘’ₐₕ x₂ = {!!}
    ←SW1SV→SW1SV→W quine← ‘’ₐₕ x₂ = {!!} -- ←SW1SV→SW1SV→W quine← ‘’ₐ x₂
    ←SW1SV→SW1SV→W (SW f₂) ‘’ₐₕ x₂ = {!!}
    ←SW1SV→SW1SV→W (→SW1SV→W f₂) ‘’ₐₕ x₂ = {!!}
    ←SW1SV→SW1SV→W (→SW1SV→SW1SV→W f₂) ‘’ₐₕ x₂ = {!!}
    ←SW1SV→SW1SV→W (f₁ ‘∘’ f₂) ‘’ₐₕ x₂ = {!!}
    _‘’ₐₕ_ {world = world} (w→ f) x₂ = w→ f ‘’ₐ x₂
    _‘’ₐₕ_ {world = world} (ww→ f) x₂ = {!!}
    _‘’ₐₕ_ {world = world} (f ‘∘’ f₁) x₂ = _‘’ₐₕ_ {world = world} f (_‘’ₐₕ_ {world = world} f₁ x₂)
    _‘’ₐₕ_ {world = world} ‘‘’ₐ’ x₂ = {!!}

    ‘‘□’’ₕ : ∀ {Γ A B} → Term {Γ ▻ A ▻ B} (W (W (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝))) → Term {Γ ▻ A ▻ B} (W (W (‘Type’ Γ)))
    ‘‘□’’ₕ t = ‘‘□’’ t

    _‘∘’ₕ_ : ∀ {Γ A B C} {world} (g : Term {Γ} (B ‘→’ C)) (f : Term (A ‘→’ B)) → Term (A ‘→’ C)
    f ‘∘’ₕ g = f ‘∘’ g-}

    in-kripke-frame-c : ∀ (world : ℕ) → Context → Context
    in-kripke-frame : ∀ {Γ} (world : ℕ) → Type Γ → Type (in-kripke-frame-c world Γ)
    in-kripke-frame-t : ∀ {Γ} (world : ℕ) {T : Type Γ} → Term T → Term (in-kripke-frame world T)

    in-kripke-frame-c world ε = ε
    in-kripke-frame-c world (Γ ▻ x) = in-kripke-frame-c world Γ ▻ in-kripke-frame world x

    _‘’ₐₕ_ : ∀ {Γ A B} → Term {Γ} (A ‘→’ B) → Term {Γ} A → Term {Γ} B
    (f₁ ‘’ₐ f₂) ‘’ₐₕ x₁ = (f₁ ‘’ₐₕ f₂) ‘’ₐ x₁
    →SW1SV→SW1SV→W quine→ ‘’ₐₕ (←SW1SV→SW1SV→W quine← ‘’ₐ f) = f
    f ‘’ₐₕ x = {!!}

    in-kripke-frame world (T ‘→’ T₁) = (in-kripke-frame world T) ‘→’ (in-kripke-frame world T₁)
    in-kripke-frame world (‘Type’ Γ) = ‘Type’ (in-kripke-frame-c world Γ)
    in-kripke-frame world (W T₁) = W (in-kripke-frame world T₁)
    in-kripke-frame world (W1 T₂) = W1 (in-kripke-frame world T₂)
    in-kripke-frame zero (‘Term’ ‘’ x) = ‘⊤’
    in-kripke-frame {Γ = Γ} (suc world) (‘Term’ ‘’ (f ‘’ₐ x)) = helper helper'
      where helper' : Term (in-kripke-frame world (‘Type’ Γ))
            helper' = simplify-term (in-kripke-frame-t world f) ‘’ₐₕ simplify-term (in-kripke-frame-t world x)

            helper : ∀ {Γ} → Term (in-kripke-frame world (‘Type’ Γ)) → Type (in-kripke-frame-c (suc world) Γ)
            helper x = {!!}
    in-kripke-frame (suc world) (‘Term’ ‘’ x) = {!in-kripke-frame world x!}
    in-kripke-frame world (T₁ ‘’ x) = {!!}
    in-kripke-frame world ‘Term’ = {!!}
    in-kripke-frame world (T ‘×’ T₁) = {!!}
    in-kripke-frame world (Quine T) = {!!}
    in-kripke-frame world ‘⊤’ = ‘⊤’
    in-kripke-frame world ‘⊥’ = ‘⊥’

    in-kripke-frame-t world ⌜ x ⌝ = ⌜ (in-kripke-frame world x) ⌝
    in-kripke-frame-t zero ⌜ t ⌝t = ‘tt’
    in-kripke-frame-t (suc world) ⌜ t ⌝t = {!!}
    in-kripke-frame-t world ‘⌜‘VAR₀’⌝t’ = {!!}
    in-kripke-frame-t world ‘⌜‘VAR₀’⌝’ = {!!}
    in-kripke-frame-t world (‘λ∙’ t) = ‘λ∙’ (in-kripke-frame-t world t)
    in-kripke-frame-t world ‘VAR₀’ = ‘VAR₀’
    in-kripke-frame-t world (t ‘’ₐ t₁) = in-kripke-frame-t world t ‘’ₐₕ in-kripke-frame-t world t₁
    in-kripke-frame-t world ‘‘×'’’ = {!!}
    in-kripke-frame-t world quine→ = {!!}
    in-kripke-frame-t world quine← = {!!}
    in-kripke-frame-t world ‘tt’ = ‘tt’
    in-kripke-frame-t world (SW t₁) = {!!}
    in-kripke-frame-t world (→SW1SV→W t₁) = {!!}
    in-kripke-frame-t world (←SW1SV→W t₁) = {!!}
    in-kripke-frame-t world (→SW1SV→SW1SV→W t₁) = {!!}
    in-kripke-frame-t world (←SW1SV→SW1SV→W t₁) = {!!}
    in-kripke-frame-t world (w t) = w (in-kripke-frame-t world t)
    in-kripke-frame-t world (w→ t) = w→ (in-kripke-frame-t world t)
    in-kripke-frame-t world (→w t) = →w (in-kripke-frame-t world t)
    in-kripke-frame-t world (ww→ t) = ww→ (in-kripke-frame-t world t)
    in-kripke-frame-t world (→ww t) = →ww (in-kripke-frame-t world t)
    in-kripke-frame-t world (t ‘∘’ t₁) = {!!}
    in-kripke-frame-t world (t w‘‘’’ₐ t₁) = {!!}
    in-kripke-frame-t world ‘‘’ₐ’ = {!!}
    in-kripke-frame-t zero (‘‘□’’ t) = w (w ⌜ ‘⊤’ ⌝)
    in-kripke-frame-t {Γ = Γ ▻ A ▻ B} (suc world) (‘‘□’’ t) = helper {lzero} (‘‘□’’ₕ (in-kripke-frame-t world t))
      where ‘‘□’’ₕ : ∀ {Γ A B} → Term {in-kripke-frame-c world Γ ▻ A ▻ B} (W (W (in-kripke-frame world (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝)))) → Term {in-kripke-frame-c world Γ ▻ A ▻ B} (W (W (‘Type’ (in-kripke-frame-c world Γ))))
            ‘‘□’’ₕ T = {!!}

            helper : ∀ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} → A → B
            helper t = {!!}
    in-kripke-frame-t world (t ‘‘→’’ t₁) = {!!}
    in-kripke-frame-t world (t ww‘‘‘→’’’ t₁) = {!!}
    in-kripke-frame-t world (t ww‘‘‘×’’’ t₁) = {!!}
{-
    in-kripke-frame zero ‘Term’ = ‘⊤’
    in-kripke-frame {Γ} world (T ‘→’ T₁) = simplify-type (in-kripke-frame world T ‘→’ in-kripke-frame world T₁)
    in-kripke-frame {Γ} world (T ‘×’ T₁) = simplify-type (in-kripke-frame world T ‘×’ in-kripke-frame world T₁)
    in-kripke-frame world (W T) = simplify-type (W (in-kripke-frame world T))
    in-kripke-frame world (W1 T) = simplify-type (W1 (in-kripke-frame world T))
    in-kripke-frame world (T₁ ‘’ x) = simplify-type (helper-ikf world (simplify-type (in-kripke-frame world T₁)) (simplify-term (in-kripke-frame-t world x)))
    in-kripke-frame world ‘⊤’ = ‘⊤’
    in-kripke-frame world ‘⊥’ = ‘⊥’
    in-kripke-frame world (‘Type’ Γ) = hold world (‘Type’ Γ)
    in-kripke-frame world (Quine T) = hold world (Quine T)
    in-kripke-frame {Γ ▻ .(‘Type’ Γ)} (suc world) ‘Term’ = ‘Term’  {-helper (in-kripke-frame-t world T v) v
      where
        helper : ∀ {Γ} → Term (‘Type’ Γ) → context-to-term Γ → Type ε
        helper ⌜ x ⌝ v = Type-in x v
        helper (t ‘‘→’’ t₁) v = helper t v ‘→’ helper t₁ v
        helper (t ‘’ₐ t₁) v = {!!}
        helper (SW t₁) v = {!!}-}

    in-kripke-frame-t : ∀ {Γ} (world : ℕ) → {T : Type Γ} → Term T → Term (in-kripke-frame world T)
    in-kripke-frame-t world ⌜ x ⌝ = ⌜ in-kripke-frame world x ⌝
    in-kripke-frame-t world ⌜ x ⌝t = ⌜ in-kripke-frame-t world x ⌝t
    in-kripke-frame-t world ‘⌜‘VAR₀’⌝t’ = ‘⌜‘VAR₀’⌝t’
    in-kripke-frame-t world ‘⌜‘VAR₀’⌝’ = ‘⌜‘VAR₀’⌝’
    in-kripke-frame-t world (‘λ∙’ x) = ‘λ∙’ (in-kripke-frame-t world x)
    in-kripke-frame-t world ‘VAR₀’ = ‘VAR₀’
    in-kripke-frame-t world (x ‘’ₐ x₁) = _‘’ₐₕ_ {world = world} (simplify-term (in-kripke-frame-t world x)) (simplify-term (in-kripke-frame-t world x₁))
    in-kripke-frame-t world ‘‘×'’’ = ‘‘×'’’
    in-kripke-frame-t world quine→ = quine→
    in-kripke-frame-t world quine← = quine←
    in-kripke-frame-t world ‘tt’ = ‘tt’
    in-kripke-frame-t world (SW x₁) = SW (in-kripke-frame-t world x₁)
    in-kripke-frame-t world (→SW1SV→W x₁) = →SW1SV→W (in-kripke-frame-t world x₁)
    in-kripke-frame-t world (←SW1SV→W x₁) = ←SW1SV→W (in-kripke-frame-t world x₁)
    in-kripke-frame-t world (→SW1SV→SW1SV→W x₁) = →SW1SV→SW1SV→W (in-kripke-frame-t world x₁)
    in-kripke-frame-t world (←SW1SV→SW1SV→W x₁) = ←SW1SV→SW1SV→W (in-kripke-frame-t world x₁)
    in-kripke-frame-t world (w x) = w (in-kripke-frame-t world x)
    in-kripke-frame-t world (w→ x) = w→ (in-kripke-frame-t world x)
    in-kripke-frame-t world (→w x) = →w (in-kripke-frame-t world x)
    in-kripke-frame-t world (ww→ x) = ww→ (in-kripke-frame-t world x)
    in-kripke-frame-t world (→ww x) = →ww (in-kripke-frame-t world x)
    in-kripke-frame-t world (x ‘∘’ x₁) = _‘∘’ₕ_ {world = world} (simplify-term (in-kripke-frame-t world x)) (simplify-term (in-kripke-frame-t world x₁))
    in-kripke-frame-t world (x w‘‘’’ₐ x₁) = simplify-term (in-kripke-frame-t world x) w‘‘’’ₐ simplify-term (in-kripke-frame-t world x₁)
    in-kripke-frame-t world ‘‘’ₐ’ = ‘‘’ₐ’
    in-kripke-frame-t zero (‘‘□’’ x) = w (w ⌜ ‘⊤’ ⌝)
    in-kripke-frame-t (suc world) (‘‘□’’ x) = ‘‘□’’ₕ (simplify-term (in-kripke-frame-t world x))
    in-kripke-frame-t world (x ‘‘→’’ x₁) = {!!}
    in-kripke-frame-t world (x ww‘‘‘→’’’ x₁) = {!!}
    in-kripke-frame-t world (x ww‘‘‘×’’’ x₁) = {!!}
-}
  kripke-reduce : ∀ {Γ} → Type Γ → context-to-term Γ → Type ε
  kripke-reduce (W x₁) v = kripke-reduce x₁ (Σ.proj₁ v)
  kripke-reduce (W1 x₂) v = kripke-reduce x₂ ((Σ.proj₁ (Σ.proj₁ v)) , (‘λ∙’ (Σ.proj₂ v) ‘’ₐ Σ.proj₂ (Σ.proj₁ v)))
  kripke-reduce (T₁ ‘’ x) v = kripke-reduce T₁ (v , x)
  kripke-reduce (‘Type’ Γ) v = Type-in (‘Type’ Γ) v
  -- kripke-reduce ‘TVAR₀’ v = {!!}
  kripke-reduce ‘Term’ (v , T) = {!!} {- Type-in (lower (Term⇓ (Σ.proj₂ v) (context-to-term⇓ (Σ.proj₁ v)))) (Σ.proj₁ v) -}
  kripke-reduce (T ‘→’ T₁) v = kripke-reduce T v ‘→’ kripke-reduce T₁ v
  kripke-reduce (T ‘×’ T₁) v = kripke-reduce T v ‘×’ kripke-reduce T₁ v
  kripke-reduce (Quine x) v = {!!}
  kripke-reduce ‘⊤’ v = ‘⊤’
  kripke-reduce ‘⊥’ v = ‘⊥’

  kripke-eval' : ∀ {Γ} → ℕ → Type Γ → context-to-term Γ → Type ε
  kripke-eval' 0 T v = Type-in T v
  kripke-eval' (suc n) T v = kripke-eval' n (kripke-reduce T v) tt

  kripke-finalize : ∀ {Γ} → Type Γ → context-to-term Γ → Type ε
  kripke-finalize (W x₁) v = kripke-finalize x₁ (Σ.proj₁ v)
  kripke-finalize (W1 x₂) v = kripke-finalize x₂ ((Σ.proj₁ (Σ.proj₁ v)) , (‘λ∙’ (Σ.proj₂ v) ‘’ₐ Σ.proj₂ (Σ.proj₁ v)))
  kripke-finalize (T₁ ‘’ x) v = kripke-finalize T₁ (v , x)
  kripke-finalize (‘Type’ Γ) v = Type-in (‘Type’ Γ) v
  -- kripke-finalize ‘TVAR₀’ v = {!!}
  kripke-finalize ‘Term’ v = ‘⊤’
  kripke-finalize (T ‘→’ T₁) v = kripke-finalize T v ‘→’ kripke-finalize T₁ v
  kripke-finalize (T ‘×’ T₁) v = kripke-finalize T v ‘×’ kripke-finalize T₁ v
  kripke-finalize (Quine x) v = {!!}
  kripke-finalize ‘⊤’ v = ‘⊤’
  kripke-finalize ‘⊥’ v = ‘⊥’

  mutual
    kripke-count : ∀ {Γ} → Type Γ → ℕ
    kripke-count (W T₁) = kripke-count T₁
    kripke-count (W1 T₂) = kripke-count T₂
    kripke-count (T₁ ‘’ x) = kripke-count T₁ + kripke-count-t x
    kripke-count (‘Type’ Γ) = 0
    -- kripke-count ‘TVAR₀’ = 0
    kripke-count ‘Term’ = 1
    kripke-count (T ‘→’ T₁) = kripke-count T + kripke-count T₁
    kripke-count (T ‘×’ T₁) = kripke-count T + kripke-count T₁
    kripke-count (Quine T) = kripke-count T
    kripke-count ‘⊤’ = 0
    kripke-count ‘⊥’ = 0

    kripke-count-t : ∀ {Γ T} → Term {Γ} T → ℕ
    kripke-count-t ⌜ x ⌝ = kripke-count x
    kripke-count-t (x ‘’ₐ x₁) = kripke-count-t x + kripke-count-t x₁
    kripke-count-t ⌜ x ⌝t = kripke-count-t x
    kripke-count-t ‘⌜‘VAR₀’⌝t’ = 0
    kripke-count-t ‘⌜‘VAR₀’⌝’ = 0
    kripke-count-t (‘λ∙’ x) = kripke-count-t x
    kripke-count-t ‘VAR₀’ = 0
    kripke-count-t quine→ = 0
    kripke-count-t quine← = 0
    kripke-count-t ‘tt’ = 0
    kripke-count-t (SW x₁) = kripke-count-t x₁
    kripke-count-t (→SW1SV→W x₁) = kripke-count-t x₁
    kripke-count-t (←SW1SV→W x₁) = kripke-count-t x₁
    kripke-count-t (→SW1SV→SW1SV→W x₁) = kripke-count-t x₁
    kripke-count-t (←SW1SV→SW1SV→W x₁) = kripke-count-t x₁
    kripke-count-t (w x) = kripke-count-t x
    kripke-count-t (w→ x) = kripke-count-t x
    kripke-count-t (→w x) = kripke-count-t x
    kripke-count-t (ww→ x) = kripke-count-t x
    kripke-count-t (→ww x) = kripke-count-t x
    kripke-count-t ‘‘×'’’ = 0
    kripke-count-t (x ‘∘’ x₁) = kripke-count-t x + kripke-count-t x₁
    kripke-count-t (x w‘‘’’ₐ x₁) = kripke-count-t x + kripke-count-t x₁
    kripke-count-t ‘‘’ₐ’ = 0
    -- kripke-count-t (f w‘‘’’ x) = kripke-count-t f + kripke-count-t x
    kripke-count-t (‘‘□’’ T) = 1 + kripke-count-t T
    kripke-count-t (x ‘‘→’’ x₁) = kripke-count-t x + kripke-count-t x₁
    kripke-count-t (x ww‘‘‘→’’’ x₁) = kripke-count-t x + kripke-count-t x₁
    kripke-count-t (x ww‘‘‘×’’’ x₁) = kripke-count-t x + kripke-count-t x₁

  kripke-normalize' : ∀ {Γ} → Type Γ → context-to-term Γ → Type ε
  kripke-normalize' T v = kripke-eval' (kripke-count T) T v

  kripke-normalize'' : ∀ {Γ} → (T : Type Γ) → Type (in-kripke-frame-c (kripke-count T) Γ)
  kripke-normalize'' T = in-kripke-frame (kripke-count T) T

open modal-fixpoint

‘Bot’ : ∀ {Γ} → Type Γ
‘Bot’ {Γ} = Quine (W1 ‘Term’ ‘’ ‘VAR₀’ ‘→’ W1 ‘Term’ ‘’ ‘VAR₀’ ‘→’ W (‘Type’ Γ)) {- a bot takes in the source code for itself, for another bot, and spits out the assertion that it cooperates with this bot -}

_cooperates-with_ : □ ‘Bot’ → □ ‘Bot’ → Type ε
b1 cooperates-with b2 = lower (Term⇓ b1 tt (lift b1) (lift b2))

‘eval-bot'’ : ∀ {Γ} → Term {Γ} (‘Bot’ ‘→’ (‘□’ ‘Bot’ ‘→’ ‘□’ ‘Bot’ ‘→’ ‘Type’ Γ))
‘eval-bot'’ = →SW1SV→SW1SV→W quine→

‘‘eval-bot'’’ : ∀ {Γ} → Term {Γ} (‘□’ ‘Bot’ ‘→’ ‘□’ ({- other -} ‘□’ ‘Bot’ ‘→’ ‘Type’ Γ))
‘‘eval-bot'’’ = ‘λ∙’ (w ⌜ ‘eval-bot'’ ⌝t w‘‘’’ₐ ‘VAR₀’ w‘‘’’ₐ ‘⌜‘VAR₀’⌝t’)

‘other-cooperates-with’ : ∀ {Γ} → Term {Γ ▻ ‘□’ ‘Bot’ ▻ W (‘□’ ‘Bot’)} (W (W (‘□’ ‘Bot’)) ‘→’ W (W (‘□’ (‘Type’ Γ))))
‘other-cooperates-with’ {Γ} = ‘eval-other'’ ‘∘’ w→ (w (w→ (w (‘λ∙’ ‘⌜‘VAR₀’⌝t’))))
  where
    ‘eval-other’ : Term {Γ ▻ ‘□’ ‘Bot’ ▻ W (‘□’ ‘Bot’)} (W (W (‘□’ (‘□’ ‘Bot’ ‘→’ ‘Type’ Γ))))
    ‘eval-other’ = w→ (w (w→ (w ‘‘eval-bot'’’))) ‘’ₐ ‘VAR₀’

    ‘eval-other'’ : Term (W (W (‘□’ (‘□’ ‘Bot’))) ‘→’ W (W (‘□’ (‘Type’ Γ))))
    ‘eval-other'’ = ww→ (w→ (w (w→ (w ‘‘’ₐ’))) ‘’ₐ ‘eval-other’)

‘self’ : ∀ {Γ} → Term {Γ ▻ ‘□’ ‘Bot’ ▻ W (‘□’ ‘Bot’)} (W (W (‘□’ ‘Bot’)))
‘self’ = w ‘VAR₀’

‘other’ : ∀ {Γ} → Term {Γ ▻ ‘□’ ‘Bot’ ▻ W (‘□’ ‘Bot’)} (W (W (‘□’ ‘Bot’)))
‘other’ = ‘VAR₀’

make-bot : ∀ {Γ} → Term {Γ ▻ ‘□’ ‘Bot’ ▻ W (‘□’ ‘Bot’)} (W (W (‘Type’ Γ))) → Term {Γ} ‘Bot’
make-bot t = ←SW1SV→SW1SV→W quine← ‘’ₐ ‘λ∙’ (→w (‘λ∙’ t))

ww‘‘‘¬’’’_ : ∀ {Γ A B}
  → Term {Γ ▻ A ▻ B} (W (W (‘□’ (‘Type’ Γ))))
  → Term {Γ ▻ A ▻ B} (W (W (‘□’ (‘Type’ Γ))))
ww‘‘‘¬’’’ T = T ww‘‘‘→’’’ w (w ⌜ ⌜ ‘⊥’ ⌝ ⌝t)

‘DefectBot’ : □ ‘Bot’
‘CooperateBot’ : □ ‘Bot’
‘FairBot’ : □ ‘Bot’
‘PrudentBot’ : □ ‘Bot’

‘DefectBot’ = make-bot (w (w ⌜ ‘⊥’ ⌝))
‘CooperateBot’ = make-bot (w (w ⌜ ‘⊤’ ⌝))
‘FairBot’ = make-bot (‘‘□’’ (‘other-cooperates-with’ ‘’ₐ ‘self’))
‘PrudentBot’ = make-bot (‘‘□’’ (φ₀ ww‘‘‘×’’’ (¬□⊥ ww‘‘‘→’’’ other-defects-against-DefectBot)))
  where
    φ₀ : ∀ {Γ} → Term {Γ ▻ ‘□’ ‘Bot’ ▻ W (‘□’ ‘Bot’)} (W (W (‘□’ (‘Type’ Γ))))
    φ₀ = ‘other-cooperates-with’ ‘’ₐ ‘self’

    other-defects-against-DefectBot : Term {_ ▻ ‘□’ ‘Bot’ ▻ W (‘□’ ‘Bot’)} (W (W (‘□’ (‘Type’ _))))
    other-defects-against-DefectBot = ww‘‘‘¬’’’ (‘other-cooperates-with’ ‘’ₐ w (w ⌜ ‘DefectBot’ ⌝t))

    ¬□⊥ : ∀ {Γ A B} → Term {Γ ▻ A ▻ B} (W (W (‘□’ (‘Type’ Γ))))
    ¬□⊥ = w (w ⌜ ⌜ ‘¬’ (‘□’ ‘⊥’) ⌝ ⌝t)

data KnownBot : Set where
  DefectBot : KnownBot
  CooperateBot : KnownBot
  FairBot : KnownBot
  PrudentBot : KnownBot

KnownBot⇓ : KnownBot → □ ‘Bot’
KnownBot⇓ DefectBot = ‘DefectBot’
KnownBot⇓ CooperateBot = ‘CooperateBot’
KnownBot⇓ FairBot = ‘FairBot’
KnownBot⇓ PrudentBot = ‘PrudentBot’

DB-defects : ∀ {b} → □ (‘¬’ (‘DefectBot’ cooperates-with b))
CB-cooperates : ∀ {b} → □ (‘CooperateBot’ cooperates-with b)

FB-spec : KnownBot → □ ‘Bot’ → Type ε
FB-spec DefectBot b = ‘¬’ (‘FairBot’ cooperates-with b)
FB-spec CooperateBot b = ‘FairBot’ cooperates-with b
FB-spec FairBot b = ‘FairBot’ cooperates-with b
FB-spec PrudentBot b = ‘FairBot’ cooperates-with b

FB-good : ∀ {b} → □ (FB-spec b (KnownBot⇓ b))

DB-defects {b} = ‘λ∙’ ‘VAR₀’
CB-cooperates {b} = ‘tt’
FB-good {DefectBot} = {!!}
FB-good {CooperateBot} = {!!}
FB-good {FairBot} = {!!}
FB-good {PrudentBot} = {!!}

{-
data Bot : Set where
  DefectBot : Bot
  CooperateBot : Bot
  FairBot : Bot
  PrudentBot : Bot

data Opponent : Set where
  Self : Opponent
  Other : Type ε → Opponent

_cooperates-with-me : ∀ {Γ} → Term {Γ} (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝ ‘→’ ‘Type’ Γ) → Term {Γ ▻ ‘Type’ Γ} (W ‘Type’ Γ)
x cooperates-with-me = w→ (w x) ‘’ₐ ‘⌜‘VAR₀’⌝’

{-
‘cooperates-with'’ : □ (‘Bot’ ‘→’ ‘Bot’ ‘→’ ‘Type’ Γ)
‘cooperates-with'’ = ‘λ∙’ (→w ((‘eval-bot’ ‘VAR₀’) ‘∘’ (w→ (w {!!}))))
  where ‘eval-bot'’ : Term (‘Bot’ ‘→’ (‘□’ ‘Bot’ ‘→’ ‘Type’ Γ))
        ‘eval-bot'’ = →SW1SV→W quine→

        ‘eval-bot’_ : Term {ε ▻ ‘Bot’} (W ‘Bot’) → Term (W (‘□’ ‘Bot’) ‘→’ W ‘Type’ Γ)
        ‘eval-bot’ b = w→ (w→ (w ‘eval-bot'’) ‘’ₐ b)

        get-bot-source : Term {ε} (‘Bot’ ‘→’ ‘□’ ‘Bot’)
        get-bot-source = {!!}-}

_‘cooperates’ : Bot → Term {ε} (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝ ‘→’ ‘Type’ Γ)
DefectBot ‘cooperates’ = ‘λ∙’ (w ⌜ ‘⊥’ ⌝)
CooperateBot ‘cooperates’ = ‘λ∙’ (w ⌜ ‘⊤’ ⌝)
FairBot ‘cooperates’ = ‘λ∙’ {!!}
PrudentBot ‘cooperates’ = {!!}

_‘cooperates-with'’_ : Bot → Term {ε} (‘Term’ ‘’ ⌜ ‘Type’ Γ ⌝ ‘→’ ‘Type’ Γ) → Type ε
FairBot ‘cooperates-with'’ x = Quine (W1 ‘Term’ ‘’ (x cooperates-with-me))
DefectBot ‘cooperates-with'’ b2 = ‘⊥’
CooperateBot ‘cooperates-with'’ b2 = ‘⊤’
PrudentBot ‘cooperates-with'’ x = Quine (W1 ‘Term’ ‘’ (x cooperates-with-me w‘‘×’’ w ⌜ (‘¬’ (‘Term’ ‘’ ⌜ ‘⊥’ ⌝) ‘→’ ‘¬’ {!!}) ⌝))
-}

   {-

  box-free? : ∀ {Γ} → Type Γ → context-to-term Γ → Set
  box-free? (T₁ ‘’ x) v = box-free? T₁ (v , x)
  box-free? ‘Type’ Γ v = ⊤
  box-free? ‘Term’ v = ⊥
  box-free? (T ‘→’ T₁) v = box-free? T v × box-free? T₁ v
  box-free? ‘⊤’ v = ⊤
  box-free? ‘⊥’ v = ⊤

  mutual
    kripke-lift→ : ∀ (n : ℕ) (T : Type ε) → box-free? (kripke-eval' n T) tt
      → Term (kripke-eval' n T ‘→’ T)
    kripke-lift→ zero T H = ‘λx∙x’
    kripke-lift→ (suc n) (T₁ ‘’ x) H = {!!}
    kripke-lift→ (suc n) (T ‘→’ T₁) H = {!!} ‘∘’ (kripke-lift→ n (kripke-reduce (T ‘→’ T₁) tt) H)
    kripke-lift→ (suc n) ‘Type’ Γ H = kripke-lift→ n _ H
    kripke-lift→ (suc n) ‘⊤’ H = kripke-lift→ n _ H
    kripke-lift→ (suc n) ‘⊥’ H = kripke-lift→ n _ H

    kripke-lift← : ∀ (n : ℕ) (T : Type ε) → box-free? (kripke-eval' n T) tt
      → Term (kripke-eval' n T)
      → Term T
    kripke-lift← n T H t = {!!}
{-    kripke-lift : ∀ {Γ} (T : Type Γ) v → Term (kripke-reduce T v ‘→’ Type-in T v)
    kripke-lift (T₁ ‘’ x) = {!!}
    kripke-lift ‘Type’ Γ v = {!!}
    kripke-lift ‘Term’ v = {!!}
    kripke-lift {ε} (T ‘→’ T₁) v = {!!}
  kripke-lift {Γ ▻ x} (T ‘→’ T₁) v = {!!}
  kripke-lift ‘⊤’ v = {!!}
  kripke-lift ‘⊥’ v = {!!}-}

  Quine : Type (ε ▻ ‘Type’ Γ) → Type ε
  Quine φ = {!!}

  quine→ : ∀ {φ} → Term {ε} (Quine φ        ‘→’ φ ‘’ ⌜ Quine φ ⌝)
  quine← : ∀ {φ} → Term {ε} (φ ‘’ ⌜ Quine φ ⌝ ‘→’ Quine φ)

  quine→ = {!!}
  quine← = {!!}
-}


module Scratch where
  open import OutsideIn.Prelude
  open import OutsideIn.X
  open import OutsideIn.Instantiations.Simple as Simple
  import OutsideIn

  data DCs : ℕ → Set where
    True : DCs 0
    False : DCs 0

  data TCs : Set where
    BoolT : TCs

  open OutsideIn(Simple DCs)

  data ⊥ : Set where
  import OutsideIn.Inference.Separator as S
  open S(Simple DCs)

  ep : ∀ {v} → SConstraint v
  ep = SConstraint.ε
  _~_ : ∀ {v} → Simple.Type v → Simple.Type v → SConstraint v
  _~_ = SConstraint._∼_

  con : SConstraint  (TCs ⨁ 7)
  con = (((((SConstraint.ε ∧′
                 (Var (suc (suc zero)) SConstraint.∼ Var (suc (suc (suc (suc zero))))))
               ∧′ (Var (suc (suc (suc zero))) SConstraint.∼ Var (suc (suc (suc (suc (suc zero)))))))
              ∧′ ((((Var (suc zero) SConstraint.∼ Var (suc (suc (suc zero))))
                    ∧′ (Var (suc zero) SConstraint.∼ Var (suc (suc (suc (suc (suc (suc (suc BoolT)))))))))
                   ∧′ (Var (suc (suc (suc (suc (suc (suc (suc BoolT))))))) SConstraint.∼ Var (suc (suc zero))))
                  ∧′ ((((Var zero SConstraint.∼ Var (suc (suc (suc zero)))) ∧′ (Var zero SConstraint.∼ Var (suc (suc (suc (suc (suc (suc (suc BoolT)))))))))
                      ∧′ (Var (suc (suc (suc (suc (suc (suc (suc BoolT))))))) SConstraint.∼ Var (suc (suc zero)))) ∧′ SConstraint.ε)))
             ∧′ (Var (suc (suc (suc (suc (suc (suc zero)))))) SConstraint.∼ ((funTy · Var (suc (suc (suc (suc zero))))) · Var (suc (suc (suc (suc (suc zero)))))))))

  con-s : SConstraint (SVar TCs 7)
  con-s = Functor.map sconstraint-is-functor svar-iso₁ con

  con′ : SConstraint (TCs ⨁ 1)
  con′ = SConstraint.ε ∧′ ((Var zero) SConstraint.∼ (Var (suc BoolT)) )

  conn : SConstraint  (TCs ⨁ 2)
  conn =  (Var (suc zero)) Simple.∼ ((funTy · Var zero) · Var zero)

  v = Simple.simplifier (λ a b → true) 1 ax SConstraint.ε conn

  open import Data.List

  --

  -- zero --> suc suc zero
  -- suc zero --> zero
  -- suc suc zero --> suc zero
  -- suc suc suc zero --> suc suc zero
  -- suc suc suc suc zero --> suc suc suc zero
  -- suc suc suc suc suc zero --> suc suc suc suc zero
  -- suc suc suc suc suc suc zero --> suc suc suc suc suc zero

  e : ∀ {tv} → Expression tv TCs _
  e = λ′ case Var (N zero) of
                ( DC True  →′ Var (DC False)
                ∣ DC False →′ Var (DC True )
                ∣ esac
                )

  e2 : ∀ {tv ev} → Expression tv ev _
  e2 = λ′ Var (N zero)

  p2 : Program ⊥ TCs
  p2 = bind₂ 1 · e2 ∷ SConstraint.ε ⇒ Var zero ⟶ Var zero
     , bind₁ e2
     , end

  p : Program ⊥ TCs
  p = bind₂ 0 · e ∷ SConstraint.ε ⇒ Var BoolT ⟶ Var BoolT
    , bind₁ e
    , end

  Γ : Environment ⊥ TCs
  Γ (DC True) = DC∀ 0 · [] ⟶ BoolT
  Γ (DC False) = DC∀ 0 · [] ⟶ BoolT
  Γ (N ())
  open import Data.Fin

  test = go ax Γ (λ a b → true) p
  test2 = go ax Γ (λ a b → true) p2


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

module Generics.Mu.All where

open import Generics.Prelude hiding (lookup)
open import Generics.Telescope
open import Generics.Desc
open import Generics.Mu

private
  variable
    P   : Telescope ⊤
    p   : ⟦ P ⟧tel tt
    V I : ExTele P
    ℓ c : Level
    n   : ℕ

AllIndArgωω
  : {X : ⟦ P , I ⟧xtel → Setω}
    (Pr : ∀ {i} → X (p , i) → Setω)
    (C : ConDesc P V I)
  → ∀ {v} → ⟦ C ⟧IndArgω X (p , v) → Setω
AllIndArgωω Pr (var _) x = Pr x
AllIndArgωω Pr (π (n , ai) S C) x = (s : < relevance ai > S _) → AllIndArgωω Pr C (x s)
AllIndArgωω Pr (A ⊗ B) (xa , xb) = AllIndArgωω Pr A xa ×ω AllIndArgωω Pr B xb

AllConωω
  : {X : ⟦ P , I ⟧xtel → Setω}
    (Pr : ∀ {i} → X (p , i) → Setω)
    (C : ConDesc P V I)
  → ∀ {v i} → ⟦ C ⟧Conω X (p , v , i) → Setω
AllConωω Pr (var f) x = ⊤ω
AllConωω Pr (π ia S C) (_ , x) = AllConωω Pr C x
AllConωω Pr (A ⊗ B) (xa , xb) = AllIndArgωω Pr A xa ×ω AllConωω Pr B xb

AllDataωω : {X  : ⟦ P , I ⟧xtel → Setω}
           (Pr : ∀ {i} → X (p , i) → Setω)
           (D : DataDesc P I n)
         → ∀ {i} (x : ⟦ D ⟧Dataω X (p , i))
         → Setω
AllDataωω Pr D (k , x) = AllConωω Pr (lookupCon D k) x

All : ∀ (D : DataDesc P I n) {c}
      (Pr : ∀ {i} → μ D (p , i) → Set c)
    → ∀ {i} → μ D (p , i) → Setω
All D Pr ⟨ x ⟩ = AllDataωω (λ x → Liftω (Pr x)) D x


-- Andreas, 2012-09-07
-- {-# OPTIONS -v tc.polarity:10 -v tc.conv.irr:20 -v tc.conv.elim:25 -v tc.conv.term:10 #-}
module Issue691 where

open import Common.Equality

data Bool : Set where
  true false : Bool

assert : (A : Set) → A → Bool → Bool
assert _ _ true  = true
assert _ _ false = false

g : Bool -> Bool -> Bool
g x true  = true
g x false = true

unsolved : Bool -> Bool
unsolved y =
  let X : Bool
      X = _
  in  assert (g X y ≡ g true y) refl X
-- X should be left unsolved

istrue : (unsolved false) ≡ true
istrue = refl


-- Binding signatures
module SOAS.Syntax.Signature (T : Set) where

open import SOAS.Syntax.Arguments {T}

open import SOAS.Common
open import SOAS.Context
open import SOAS.Variable

open import SOAS.Families.Core {T}
open import SOAS.Families.BCCC {T} using (⊤ₘ)

open import SOAS.Coalgebraic.Strength
open import SOAS.Coalgebraic.Lift
open import SOAS.Coalgebraic.Map

open import SOAS.Abstract.Hom

open import SOAS.Abstract.ExpStrength
import SOAS.Abstract.Coalgebra as →□
open →□.Sorted
open →□.Unsorted renaming (Coalg to UCoalg ; Coalg⇒ to UCoalg⇒)

open import Data.List.Base using ([] ; _∷_ ; List)

private
  variable
    Γ Δ Θ : Ctx
    α τ : T

-- Binding signature for a second-order syntax, consisting of a set of operators
-- O and an arity assignment ∣_∣
record Signature (O : Set) : Set₁ where
  constructor sig
  field ∣_∣ : O → List (Ctx × T) × T

  -- Sort and arity of an operator
  Sort : O → T
  Sort o = proj₂ ∣ o ∣

  Arity : O → List (Ctx × T)
  Arity o = proj₁ ∣ o ∣

  -- Signature endofunctor
  ⅀F : Functor 𝔽amiliesₛ 𝔽amiliesₛ
  ⅀F  = record
    { F₀ = λ 𝒳 α Γ → Σ[ o ∈ O ] (α ≡ Sort o × Arg (Arity o) 𝒳 Γ)
    ; F₁ = λ{ f (o , e , ar) → o , e , (F₁ o f ar)}
    ; identity = λ{ {x = o , e , ar} → cong (λ - → o , e , -) (identity o) }
    ; homomorphism = λ{ {x = o , e , ar} → cong (λ - → o , e , -) (homomorphism o) }
    ; F-resp-≈ = λ{ p {x = o , e , ar} → cong (λ - → o , e , -) (F-resp-≈ o p) }
    } where open module AF o =  Functor (ArgF (Arity o))

  pattern _⋮_ o ar = (o , refl , ar)
  infix 1 _⋮_

  open import SOAS.Metatheory.Algebra {T} ⅀F public

  -- Coalgebraic and exponential strength for signature endofunctor
  private
    str : {𝒫 : Familyₛ}(𝒫ᴮ : Coalgₚ 𝒫)(𝒳 : Familyₛ)
          (as : List (Ctx × T))(σ : Γ ~[ 𝒫 ]↝ Δ)
        → Arg as 〖 𝒫 , 𝒳 〗 Γ → Arg as 𝒳 Δ
    str 𝒫ᴮ 𝒳 [] σ x = tt
    str 𝒫ᴮ 𝒳 ((Θ , τ) ∷ []) σ h = h (lift 𝒫ᴮ Θ σ)
    str 𝒫ᴮ 𝒳 ((Θ , τ) ∷ a ∷ as) σ (h , at) = h (lift 𝒫ᴮ Θ σ) , str 𝒫ᴮ 𝒳 (a ∷ as) σ at

    str-nat₁ : {𝒫 𝒬 𝒳 : Familyₛ} {𝒫ᴮ : Coalgₚ 𝒫} {𝒬ᴮ : Coalgₚ 𝒬}
             → {f : 𝒬 ⇾̣ 𝒫} (fᴮ⇒ : Coalgₚ⇒ 𝒬ᴮ 𝒫ᴮ f)
             → (as : List (Ctx × T))
             → (h : Arg as 〖 𝒫 , 𝒳 〗 Γ) (σ : Γ ~[ 𝒬 ]↝ Δ)
             → str 𝒫ᴮ 𝒳 as (λ x → f (σ x)) h
             ≡ str 𝒬ᴮ 𝒳 as σ (Arg₁ as (λ{ h′ ς → h′ (λ v → f (ς v))}) h)
    str-nat₁ fᴮ⇒ [] h σ = refl
    str-nat₁ {𝒳 = 𝒳} fᴮ⇒ ((Θ , τ) ∷ []) h σ = lift-comp 𝒳 Θ fᴮ⇒ h σ
    str-nat₁ {𝒳 = 𝒳} fᴮ⇒ ((Θ , τ) ∷ a ∷ as) (h , ap) σ =
      cong₂ _,_ (lift-comp 𝒳 Θ fᴮ⇒ h σ) (str-nat₁ fᴮ⇒ (a ∷ as) ap σ)

    str-nat₂ : {𝒫 𝒳 𝒴 : Familyₛ} {𝒫ᴮ : Coalgₚ 𝒫}
             → (f : 𝒳 ⇾̣ 𝒴)
             → (as : List (Ctx × T))
             → (h : Arg as 〖 𝒫 , 𝒳 〗 Γ) (σ : Γ ~[ 𝒫 ]↝ Δ)
             → str 𝒫ᴮ 𝒴 as σ (Arg₁ as (λ{ h′ ς → f (h′ ς)}) h)
             ≡ Arg₁ as f (str 𝒫ᴮ 𝒳 as σ h)
    str-nat₂ f [] h σ = refl
    str-nat₂ f ((Θ , τ) ∷ []) h σ = refl
    str-nat₂ f ((Θ , τ) ∷ a ∷ as) (h , ap) σ = cong (_ ,_) (str-nat₂ f (a ∷ as) ap σ)

    str-unit : (𝒳 : Familyₛ)
             → (as : List (Ctx × T))
             → (h : Arg as 〖 ℐ , 𝒳 〗 Γ)
             → str ℐᴮ 𝒳 as id h
             ≡ Arg₁ as (λ b → b id) h
    str-unit 𝒳 [] h = refl
    str-unit 𝒳 ((Θ , τ) ∷ []) h = rlift-id 𝒳 Θ h
    str-unit 𝒳 ((Θ , τ) ∷ a ∷ as) (h , ap) = cong₂ _,_ (rlift-id 𝒳 Θ h) (str-unit 𝒳 (a ∷ as) ap)

    str-assoc : (𝒳 : Familyₛ) {𝒫 𝒬 ℛ : Familyₛ}
                {𝒫ᴮ : Coalgₚ 𝒫} {𝒬ᴮ : Coalgₚ 𝒬} {ℛᴮ : Coalgₚ ℛ}
              → {f : 𝒫 ⇾̣ 〖 𝒬 , ℛ 〗} (fᶜ : Coalgebraic 𝒫ᴮ 𝒬ᴮ ℛᴮ f)
              → (open Coalgebraic fᶜ)
              → (as : List (Ctx × T))
              → (h : Arg as 〖 ℛ , 𝒳 〗 Γ) (σ : Γ ~[ 𝒫 ]↝ Δ) (ς : Δ ~[ 𝒬 ]↝ Θ)
              → str ℛᴮ 𝒳 as (λ v → f (σ v) ς) h
              ≡ str 𝒬ᴮ 𝒳 as ς (str 〖𝒫,𝒴〗ᴮ 〖 𝒬 , 𝒳 〗 as (f ∘ σ) (Arg₁ as (λ{ h ς σ → h (λ v → ς v σ)}) h))
    str-assoc 𝒳 fᶜ [] h σ ς = refl
    str-assoc 𝒳 fᶜ ((Ξ , τ) ∷ []) h σ ς = lift-assoc 𝒳 Ξ fᶜ h σ ς
    str-assoc 𝒳 fᶜ ((Ξ , τ) ∷ a ∷ as) (h , ap) σ ς = cong₂ _,_ (lift-assoc 𝒳 Ξ fᶜ h σ ς) (str-assoc 𝒳 fᶜ (a ∷ as) ap σ ς)

    estr : {X : Family}(Xᵇ : UCoalg X)(𝒴 : Familyₛ)
          (as : List (Ctx × T))
        → Arg as (X ⇨ 𝒴) Γ → (x : X Γ) → Arg as 𝒴 Γ
    estr Xᵇ 𝒴 [] at x = tt
    estr Xᵇ 𝒴 ((Θ , τ) ∷ []) e x = e (UCoalg.wkr Xᵇ Θ x)
    estr Xᵇ 𝒴 ((Θ , τ) ∷ a ∷ as) (e , at) x = (e (UCoalg.wkr Xᵇ Θ x)) , estr Xᵇ 𝒴 (a ∷ as) at x

    estr-nat₁ : {X X′ : Family} {Xᵇ : UCoalg X}
      {X′ᵇ : UCoalg X′} {𝒴 : Familyₛ} {f : X′ ⇾ X} →
      UCoalg⇒ X′ᵇ Xᵇ f →
      (as : List (Ctx × T))
      (h : Arg as (X ⇨ 𝒴) Γ)(x : X′ Γ)
      → estr Xᵇ 𝒴 as h (f x)
      ≡ estr X′ᵇ 𝒴 as (Arg₁ as (λ e x₁ → e (f x₁)) h) x
    estr-nat₁ fᵇ⇒ [] h x = refl
    estr-nat₁ fᵇ⇒ ((Θ , τ) ∷ []) h x = cong h (sym (UCoalg⇒.⟨r⟩ fᵇ⇒))
    estr-nat₁ fᵇ⇒ ((Θ , τ) ∷ a ∷ as) (h , at) x = cong₂ _,_ (cong h (sym (UCoalg⇒.⟨r⟩ fᵇ⇒))) (estr-nat₁ fᵇ⇒ (a ∷ as) at x)

    estr-nat₂ : {X : Family} {Xᵇ : UCoalg X}
        {𝒴 𝒴′ : Familyₛ} (g : 𝒴 ⇾̣ 𝒴′) (as : List (Ctx × T))(at : Arg as (X ⇨ 𝒴) Γ) (x : X Γ)
        → estr Xᵇ 𝒴′ as (Arg₁ as (λ e x → g (e x)) at) x
        ≡ Arg₁ as g (estr Xᵇ 𝒴 as at x)
    estr-nat₂ g [] at x = refl
    estr-nat₂ g ((Θ , τ) ∷ []) h x = refl
    estr-nat₂ g ((Θ , τ) ∷ a ∷ as) (h , at) x = cong (_ ,_) (estr-nat₂ g (a ∷ as) at x)

    estr-unit : {𝒴 : Familyₛ} (as : List (Ctx × T)) {at : Arg as (⊤ₘ ⇨ 𝒴) Γ}
        → estr ⊤ᵇ 𝒴 as at tt ≡ Arg₁ as (λ e′ → e′ tt) at
    estr-unit [] = refl
    estr-unit ((Θ , τ) ∷ []) = refl
    estr-unit ((Θ , τ) ∷ a ∷ as) = cong (_ ,_) (estr-unit (a ∷ as))

  -- Compatible strengths for the signature endofunctor
  ⅀:CompatStr : CompatStrengths ⅀F
  ⅀:CompatStr = record
    { CoalgStr = record
      { str = λ{ 𝒫ᴮ 𝒳 (o , e , ap) σ → o , (e , str 𝒫ᴮ 𝒳 (Arity o) σ ap) }
      ; str-nat₁ = λ{ fᴮ⇒ (o , e , ap) σ → cong (λ - → o , e , -) (str-nat₁ fᴮ⇒ (Arity o) ap σ)}
      ; str-nat₂ = λ{ f (o , e , ap) σ → cong (λ - → o , e , -) (str-nat₂ f (Arity o) ap σ)}
      ; str-unit = λ{ 𝒳 (o , e , ap) → cong (λ - → o , e , -) (str-unit 𝒳 (Arity o) ap)}
      ; str-assoc = λ{ 𝒳 fᶜ (o , e , ap) σ ς → cong (λ - → o , e , -) (str-assoc 𝒳 fᶜ (Arity o) ap σ ς)}
      }
    ; ExpStr = record
      { estr = λ{ Xᵇ 𝒴 (o , refl , at) x → o , refl , estr Xᵇ 𝒴 (Arity o) at x }
      ; estr-nat₁ = λ{ fᵇ⇒ (o , refl , at) x → cong (λ - → o , refl , -) (estr-nat₁ fᵇ⇒ (Arity o) at x)}
      ; estr-nat₂ = λ{ g (o , refl , at) x → cong (λ - → o , refl , -) (estr-nat₂ g (Arity o) at x) }
      ; estr-unit = λ{ {e = (o , refl , at)} → cong (λ - → o , refl , -) (estr-unit (Arity o)) } }
    }


open import Oscar.Class.Similarity
open import Oscar.Class.Reflexivity
open import Oscar.Class.Surjection
open import Oscar.Class.Leftunit
open import Oscar.Class.Smap
open import Oscar.Class.Symmetrical
open import Oscar.Class.Unit
open import Oscar.Data.Surjcollation
open import Oscar.Prelude

module Oscar.Class.Smapoid where

module _
  {𝔵₁} {𝔛₁ : Ø 𝔵₁}
  {𝔵₂} {𝔛₂ : Ø 𝔵₂}
  {𝔯} (ℜ : 𝔛₁ → 𝔛₁ → Ø 𝔯)
  {𝔭₁} (𝔓₁ : 𝔛₂ → Ø 𝔭₁)
  {𝔭₂} (𝔓₂ : 𝔛₂ → Ø 𝔭₂)
  {𝔯̇} (ℜ̇ : ∀ {x y} → ℜ x y → ℜ x y → Ø 𝔯̇)
  {𝔭̇₁₁} (𝔓̇₁₁ : ∀ {x} → 𝔓₁ x → 𝔓₁ x → Ø 𝔭̇₁₁)
  {𝔭̇₂₂} (𝔓̇₂₂ : ∀ {x} → 𝔓₂ x → 𝔓₂ x → Ø 𝔭̇₂₂)
  {𝔭̇₁₂} (𝔓̇₁₂ : ∀ {x} → 𝔓₁ x → 𝔓₂ x → Ø 𝔭̇₁₂)
  where
  record IsSmapoid : Ø 𝔵₁ ∙̂ 𝔵₂ ∙̂ 𝔯 ∙̂ 𝔯̇ ∙̂ 𝔭₁ ∙̂ 𝔭₂ ∙̂ 𝔭̇₁₁ ∙̂ 𝔭̇₂₂ ∙̂ 𝔭̇₁₂ where
    constructor ∁
    field

      ⦃ `Surjection ⦄ : Surjection.class 𝔛₁ 𝔛₂

      -- ℜ 𝓂 𝓃 → 𝔓₁ (surjection 𝓂) → 𝔓₂ (surjection 𝓃)
      ⦃ `Smaparrow ⦄ : Smaparrow.class ℜ 𝔓₁ 𝔓₂ surjection surjection -- epfs, Smap

      -- 𝒫 ₁≈₁ 𝒬 → 𝒻 ◃ 𝒫 ₂≈₂ 𝒻 ◃ 𝒬
      ⦃ `leftSim ⦄ : Similarity,smaparrow!.class ℜ 𝔓₁ 𝔓₂ 𝔓̇₁₁ 𝔓̇₂₂ -- fact5, Similarity, Smaparrowleftsimilarity

      ⦃ `𝓡eflexivity ⦄ : Reflexivity.class ℜ

      -- 𝒫 ₁≈₂ 𝒖 ◃ 𝒫
      ⦃ `leftyunit ⦄ : ∀ {x} {p : 𝔓₁ (surjection x)}
                     → Leftunit.class (flip (𝔓̇₁₂ {surjection x})) ε smap p

module _
  {𝔵₁} {𝔛₁ : Ø 𝔵₁}
  {𝔵₂} {𝔛₂ : Ø 𝔵₂}
  {𝔯} (ℜ : 𝔛₁ → 𝔛₁ → Ø 𝔯)
  {𝔭₁} (𝔓₁ : 𝔛₂ → Ø 𝔭₁)
  {𝔭₂} (𝔓₂ : 𝔛₂ → Ø 𝔭₂)
  {𝔯̇} (ℜ̇ : ∀ {x y} → ℜ x y → ℜ x y → Ø 𝔯̇)
  {𝔭̇₁₁} (𝔓̇₁₁ : ∀ {x} → 𝔓₁ x → 𝔓₁ x → Ø 𝔭̇₁₁)
  {𝔭̇₂₂} (𝔓̇₂₂ : ∀ {x} → 𝔓₂ x → 𝔓₂ x → Ø 𝔭̇₂₂)
  {𝔭̇₁₂} (𝔓̇₁₂ : ∀ {x} → 𝔓₁ x → 𝔓₂ x → Ø 𝔭̇₁₂)
  where
  record IsSmapoidR : Ø 𝔵₁ ∙̂ 𝔵₂ ∙̂ 𝔯 ∙̂ 𝔯̇ ∙̂ 𝔭₁ ∙̂ 𝔭₂ ∙̂ 𝔭̇₁₁ ∙̂ 𝔭̇₂₂ ∙̂ 𝔭̇₁₂ where
    constructor ∁
    field

      ⦃ `IsSmapoid ⦄ : IsSmapoid ℜ 𝔓₁ 𝔓₂ ℜ̇ 𝔓̇₁₁ 𝔓̇₂₂ 𝔓̇₁₂

      -- 𝒻 ᵣ≈ᵣ ℊ → 𝒻 ◃ 𝒫 ₂≈₂ ℊ ◃ 𝒫
      ⦃ `rightSim ⦄ : Similarity,cosmaparrow!.class ℜ 𝔓₁ 𝔓₂ ℜ̇ 𝔓̇₂₂ -- fact6, Similarity, Smaparrowrightsimilarity

-- TODO add these somewhere?
-- fact4 needs Propergroup's Nothing -- ⦃ `Leftstar ⦄ : Leftstar.class
-- left-identity-∧ needs Propergroup
-- fact1 -- ⦃ `Symmetrical ⦄ : ∀ {m} → Symmetrical (surjcollation[ 𝔓 ]⟦ ℜ / 𝔓̇ ⟧ {m}) (λ { (∁ f) (∁ g) → {!f {m}!}})
-- Properties-fact1


module index where

-- A formalisation of Haskell B. Curry’s thesis Grundlagen der Kombinatorischen
-- Logik. See <https://www.jstor.org/stable/2370619> (part 1) and
-- <https://www.jstor.org/stable/2370716> (part 2).
import CombinatoryLogic.Equality
import CombinatoryLogic.Forest
import CombinatoryLogic.Semantics
import CombinatoryLogic.Syntax

-- A formalisation of the theory and problems presented in To Mock a Mockingbird
-- by Raymond Smullyan.
import Mockingbird.Forest
import Mockingbird.Forest.Base
import Mockingbird.Forest.Birds
import Mockingbird.Forest.Combination
import Mockingbird.Forest.Combination.Base
import Mockingbird.Forest.Combination.Properties
import Mockingbird.Forest.Combination.Vec
import Mockingbird.Forest.Combination.Vec.Base
import Mockingbird.Forest.Combination.Vec.Properties
import Mockingbird.Forest.Extensionality
import Mockingbird.Problems.Chapter09
import Mockingbird.Problems.Chapter10
import Mockingbird.Problems.Chapter11
import Mockingbird.Problems.Chapter12
import Mockingbird.Problems.Chapter13
import Mockingbird.Problems.Chapter14
import Mockingbird.Problems.Chapter15
import Mockingbird.Problems.Chapter16
import Mockingbird.Problems.Chapter17
import Mockingbird.Problems.Chapter18
import Mockingbird.Problems.Chapter19
import Mockingbird.Problems.Chapter20


{-# OPTIONS --cubical-compatible #-}
module Common.Char where

open import Agda.Builtin.Char public
open import Common.Bool

charEq : Char -> Char -> Bool
charEq = primCharEquality


{-# OPTIONS --universe-polymorphism #-}
module SortDependingOnIndex where

open import Imports.Level

data Bad : (l : Level) → Set l where


------------------------------------------------------------------------
-- Application of substitutions
------------------------------------------------------------------------

-- Given an operation which applies a substitution to a term, subject
-- to some conditions, more operations and lemmas are defined/proved.

-- (This module reexports various other modules.)

open import Data.Universe.Indexed

module deBruijn.Substitution.Data.Application
  {i u e} {Uni : IndexedUniverse i u e} where

import deBruijn.Substitution.Data.Application.Application
open deBruijn.Substitution.Data.Application.Application
  {_} {_} {_} {Uni} public
import deBruijn.Substitution.Data.Application.Application21
open deBruijn.Substitution.Data.Application.Application21
  {_} {_} {_} {Uni} public
import deBruijn.Substitution.Data.Application.Application22
open deBruijn.Substitution.Data.Application.Application22
  {_} {_} {_} {Uni} public
import deBruijn.Substitution.Data.Application.Application1
open deBruijn.Substitution.Data.Application.Application1
  {_} {_} {_} {Uni} public


module Issue1494 where

open import Issue1494.Helper

module M (r : Record) where

  open Module r

  postulate
    A   : Set
    a b : A

  Foo : a ≡ b
  Foo = {!!}