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

-- This module shows that D<: subtyping without transitivity, or equivalently, without
-- bad bounds, remains undecidable.
module DsubNoTrans where

open import Data.List as List
open import Data.List.All as All
open import Data.Nat as ℕ
open import Data.Maybe as Maybe
open import Data.Product
open import Data.Sum
open import Data.Empty renaming (⊥ to False)
open import Data.Vec as Vec renaming (_∷_ to _‼_ ; [] to nil) hiding (_++_)
open import Function

open import Data.Maybe.Properties as Maybeₚ
open import Data.Nat.Properties as ℕₚ
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality as ≡
open import Induction.Nat

open import DsubDef
open import DsubReduced
open import FsubMinus
open import FsubMinus2
open import Utils

infix 4 _⊢_<:_
data _⊢_<:_ : Env → Typ → Typ → Set where
  <:⊤  : ∀ {Γ T} → Γ ⊢ T <: ⊤
  ⊥<:  : ∀ {Γ T} → Γ ⊢ ⊥ <: T
  refl : ∀ {Γ T} → Γ ⊢ T <: T
  bnd  : ∀ {Γ S U S′ U′} →
           Γ ⊢ S′ <: S →
           Γ ⊢ U <: U′ →
           Γ ⊢ ⟨A: S ⋯ U ⟩ <: ⟨A: S′ ⋯ U′ ⟩
  Π<:  : ∀ {Γ S U S′ U′} →
           Γ ⊢ S′ <: S →
           Γ ‣ S′ ! ⊢ U <: U′ →
           Γ ⊢ Π S ∙ U <: Π S′ ∙ U′
  sel₁ : ∀ {Γ n T S} →
           env-lookup Γ n ≡ just T →
           Γ ⊢ T <: ⟨A: S ⋯ ⊤ ⟩ →
           Γ ⊢ S <: n ∙A
  sel₂ : ∀ {Γ n T U} →
           env-lookup Γ n ≡ just T →
           Γ ⊢ T <: ⟨A: ⊥ ⋯ U ⟩ →
           Γ ⊢ n ∙A <: U

module Contravariant where
  open InvertibleProperties contraInvertible _⊢_<:_ public

  D⇒Dᵢ : ∀ {Γ S U} → Γ ⊢ S <: U → ContraEnv Γ → Γ ⊢ᵢ S <: U
  D⇒Dᵢ <:⊤ all                        = ditop
  D⇒Dᵢ ⊥<: all                        = dibot
  D⇒Dᵢ refl all                       = direfl
  D⇒Dᵢ (bnd S′<:S U<:U′) all          = dibnd (D⇒Dᵢ S′<:S all) (D⇒Dᵢ U<:U′ all)
  D⇒Dᵢ (Π<: S′<:S U<:U′) all          = diall (D⇒Dᵢ S′<:S all) U<:U′
  D⇒Dᵢ (sel₁ T∈Γ S<:U) all with lookupContraEnv T∈Γ all
  ... | ctt _ with ⟨A:⟩<:⟨A:⟩ (D⇒Dᵢ S<:U all) all
  ...            | S<:⊥ , _ with <:⊥ S<:⊥ all
  ...                          | refl = dibot
  D⇒Dᵢ (sel₂ T∈Γ S<:U) all with lookupContraEnv T∈Γ all
  ... | ctt _ with ⟨A:⟩<:⟨A:⟩ (D⇒Dᵢ S<:U all) all
  ...            | _ , U′<:U          = ditrans _ (disel T∈Γ) U′<:U

module Undecidability′ where
  open FsubMinusToDsubR
  open Contravariant hiding (Π<:)

  ⟨A:⊥⟩<:-lb : ∀ {Γ T S U} → Γ ⊢ ⟨A: ⊥ ⋯ T ⟩ <: ⟨A: S ⋯ U ⟩ → ContraEnv Γ → S ≡ ⊥
  ⟨A:⊥⟩<:-lb D cΓ with ⟨A:⟩<:⟨A:⟩ (D⇒Dᵢ D cΓ) cΓ
  ... | S<:⊥ , _  with <:⊥ S<:⊥ cΓ
  ...                | S≡⊥ = S≡⊥

  <:⇒<:ᵣ : ∀ {Γ S U} →
              Γ ⊢ S <: U →
              ContraEnv Γ → Covar S → Covar U →
              Γ ⊢ᵣ S <: U
  <:⇒<:ᵣ <:⊤ cΓ cS cU                                           = drtop cS
  <:⇒<:ᵣ ⊥<: cΓ () cU
  <:⇒<:ᵣ refl cΓ cS cU                                          = drrefl cU
  <:⇒<:ᵣ (bnd S′<:S U<:U′) cΓ cS ()
  <:⇒<:ᵣ (Π<: <:⊤ U<:U′) cΓ () cU
  <:⇒<:ᵣ (Π<: ⊥<: U<:U′) cΓ cS ()
  <:⇒<:ᵣ (Π<: refl U<:U′) cΓ (cvΠ cS cU) (cvΠ cS′ cU′)          = drall cS′ cU cS′ cU′
                                                                        (drrefl cS′)
                                                                        (<:⇒<:ᵣ U<:U′ (ctt cS′ ∷ cΓ) cU cU′)
  <:⇒<:ᵣ (Π<: (bnd _ S′<:S) U<:U′) cΓ (cvΠ cS cU) (cvΠ cS′ cU′) = drall cS cU cS′ cU′
                                                                        (<:⇒<:ᵣ S′<:S cΓ cS′ cS)
                                                                        (<:⇒<:ᵣ U<:U′ (ctt cS′ ∷ cΓ) cU cU′)
  <:⇒<:ᵣ (Π<: (Π<: S′<:S S′<:S₁) U<:U′) cΓ () cU
  <:⇒<:ᵣ (Π<: (sel₁ x S′<:S) U<:U′) cΓ () cU
  <:⇒<:ᵣ (Π<: (sel₂ x S′<:S) U<:U′) cΓ cS ()
  <:⇒<:ᵣ (sel₁ T∈Γ T<:B) cΓ cS cU
    with lookupContraEnv T∈Γ cΓ
  ... | ctt _  with ⟨A:⊥⟩<:-lb T<:B cΓ
  ...             | refl                                        = case cS of λ ()
  <:⇒<:ᵣ (sel₂ T∈Γ T<:B) cΓ cS cU
    with lookupContraEnv T∈Γ cΓ
  ... | ctt cT                                                  = drsel T∈Γ cT (aux T<:B cΓ cT cU)
    where aux : ∀ {Γ T S U} → Γ ⊢ ⟨A: ⊥ ⋯ T ⟩ <: ⟨A: S ⋯ U ⟩ → ContraEnv Γ → Covar T → Covar U → Γ ⊢ᵣ T <: U
          aux refl cΓ cT cU         = drrefl cU
          aux (bnd _ T<:U) cΓ cT cU = <:⇒<:ᵣ T<:U cΓ cT cU

  <:ᵣ⇒<: : ∀ {Γ S U} → Γ ⊢ᵣ S <: U → Γ ⊢ S <: U
  <:ᵣ⇒<: (drtop _)                   = <:⊤
  <:ᵣ⇒<: (drrefl _)                  = refl
  <:ᵣ⇒<: (drall _ _ _ _ S′<:S U<:U′) = Π<: (bnd ⊥<: (<:ᵣ⇒<: S′<:S)) (<:ᵣ⇒<: U<:U′)
  <:ᵣ⇒<: (drsel T∈Γ _ T<:B)          = sel₂ T∈Γ (bnd ⊥<: (<:ᵣ⇒<: T<:B))

  open FsubMinus.FsubMinus

  F<:⇒D<: : ∀ {Γ S U} → Γ ⊢F S <: U → ⟪ Γ ⟫ ⊢ ⟦ S ⟧ <: ⟦ U ⟧
  F<:⇒D<: = <:ᵣ⇒<: ∘ F<:⇒D<:ᵣ

  D<:⇒F<: : ∀ {Γ S U} → ⟪ Γ ⟫ ⊢ ⟦ S ⟧ <: ⟦ U ⟧ → Γ ⊢F S <: U
  D<:⇒F<: S<:U = D<:ᵣ⇒F<: (<:⇒<:ᵣ S<:U (⟪⟫-contraEnv _) (⟦⟧-covar _) (⟦⟧-covar _))
                          refl refl refl


-- Andreas, 2016-11-19 issue #2308

-- Since fix of #2197, in mutual blocks, records are no-eta-equality
-- until the positivity checker has run.
-- Thus, the record pattern translation might not kick in.

-- Now, there is another pass of record pattern translation
-- after the mutual block has finished.

data Unit : Set where
  unit : Unit

mutual -- needed to trigger issue

  record R : Set where  -- needs to be in mutual block
    constructor wrap
    field f : Unit

  G : R → Set
  G (wrap _) = Unit -- match on wrap needed

test : (x : R) → G x → Set₁
test _ unit = Set

-- ERROR WAS:
-- Type mismatch
-- when checking that the pattern unit has type G x

-- Should succeed.


open import Data.Empty
open import Data.Maybe
open import Data.Product
open import Data.Sum
open import Data.Unit

open import AEff
open import AwaitingComputations
open import EffectAnnotations
open import Preservation
open import Renamings
open import Substitutions
open import Types

open import Relation.Binary.PropositionalEquality hiding ([_])
open import Relation.Nullary
open import Relation.Nullary.Negation

module Progress where

-- WRAPPING PROMISES AROUND A CONTEXT

⟨⟨_⟩⟩ : Ctx → Ctx
⟨⟨ [] ⟩⟩ = []
⟨⟨ Γ ∷ X ⟩⟩ = ⟨⟨ Γ ⟩⟩ ∷ ⟨ X ⟩

-- RESULTS

data RunResult⟨_∣_⟩ (Γ : Ctx) : {C : CType} → ⟨⟨ Γ ⟩⟩ ⊢M⦂ C → Set where

  return   : {X : VType}
             {o : O}
             {i : I}
             (V : ⟨⟨ Γ ⟩⟩ ⊢V⦂ X) →
             ------------------------------------------
             RunResult⟨ Γ ∣ return {o = o} {i = i} V ⟩

  promise  : {X Y : VType}
             {o o' : O}
             {i i' : I}
             {op : Σₛ}
             {p : lkpᵢ op i ≡ just (o' , i')}
             {M : ⟨⟨ Γ ⟩⟩ ∷ ``(payload op) ⊢M⦂ ⟨ X ⟩ ! (o' , i')}
             {N : ⟨⟨ Γ ⟩⟩ ∷ ⟨ X ⟩ ⊢M⦂ Y ! (o , i)} →
             RunResult⟨ Γ ∷ X ∣ N ⟩ →
             ----------------------------------------------------
             RunResult⟨ Γ ∣ promise op ∣ p ↦ M `in N ⟩

  awaiting : {C : CType}
             {Y : VType}
             {y : ⟨ Y ⟩ ∈ ⟨⟨ Γ ⟩⟩}
             {M : ⟨⟨ Γ ⟩⟩ ⊢M⦂ C} →
             y ⧗ M →
             ---------------------
             RunResult⟨ Γ ∣ M ⟩

data CompResult⟨_∣_⟩ (Γ : Ctx) : {C : CType} → ⟨⟨ Γ ⟩⟩ ⊢M⦂ C → Set where

  comp   : {C : CType}
           {M : ⟨⟨ Γ ⟩⟩ ⊢M⦂ C} →
           RunResult⟨ Γ ∣ M ⟩ →
           ---------------------
           CompResult⟨ Γ ∣ M ⟩

  signal : {X : VType}
           {o : O}
           {i : I}
           {op : Σₛ}
           {p : op ∈ₒ o}
           {V : ⟨⟨ Γ ⟩⟩ ⊢V⦂ ``(payload op)}
           {M : ⟨⟨ Γ ⟩⟩ ⊢M⦂ X ! (o , i)} →
           CompResult⟨ Γ ∣ M ⟩ →
           --------------------------------
           CompResult⟨ Γ ∣ ↑ op p V M ⟩

-- PROGRESS THEOREM FOR PROMISE-OPEN COMPUTATIONS

⇒-not-in-ctx : {Γ : Ctx} {X : VType} {C : CType} → X ⇒ C ∈ ⟨⟨ Γ ⟩⟩ → ⊥
⇒-not-in-ctx {Γ ∷ y} (Tl x) =
  ⇒-not-in-ctx x

{- THEOREM 3.3 -}

progress : {Γ : Ctx}
           {C : CType} →
           (M : ⟨⟨ Γ ⟩⟩ ⊢M⦂ C) →
           -------------------------------
           (Σ[ N ∈ ⟨⟨ Γ ⟩⟩ ⊢M⦂ C ] (M ↝ N)
            ⊎
            CompResult⟨ Γ ∣ M ⟩)

progress (return V) =
  inj₂ (comp (return V))
progress (let= M `in N) with progress M
... | inj₁ (M' , r) =
  inj₁ (_ , context (let= [-] `in N) r)
... | inj₂ (comp (return V)) =
  inj₁ (_ , let-return V N)
... | inj₂ (comp (promise {_} {_} {_} {_} {_} {_} {_} {p} {M'} {M''} R)) =
  inj₁ (_ , let-promise p M' M'' N)
... | inj₂ (comp (awaiting R)) =
  inj₂ (comp (awaiting (let-in R)))
... | inj₂ (signal {_} {_} {_} {_} {p} {V} {M'} R) =
  inj₁ (_ , let-↑ p V M' N)
progress (letrec M `in N) =
  inj₁ (_ , letrec-unfold M N)
progress ((` x) · W) with ⇒-not-in-ctx x
... | ()
progress (ƛ M · W) =
  inj₁ (_ , apply M W)
progress (↑ op p V M) with progress M
... | inj₁ (M' , r) =
  inj₁ (_ , context (↑ op p V [-]) r)
... | inj₂ R =
  inj₂ (signal R)
progress (↓ op V M) with progress M
... | inj₁ (M' , r) =
  inj₁ (_ , context (↓ op V [-]) r)
... | inj₂ (comp (return W)) =
  inj₁ (_ , (↓-return V W))
... | inj₂ (comp (awaiting R)) =
  inj₂ (comp (awaiting (interrupt R)))
... | inj₂ (signal {X} {o} {i} {op'} {p} {W} {M'} R) =
  inj₁ (_ , (↓-↑ p V W M'))
... | inj₂ (comp (promise {_} {_} {_} {_} {_} {_} {op'} {p} {M'} {M''} R)) with decₛ op op'
... | yes refl =
  inj₁ (_ , ↓-promise-op p V M' M'')
... | no ¬q =
  inj₁ (_ , ↓-promise-op' ¬q p V M' M'')
progress (promise op ∣ p ↦ M `in N) with progress N
... | inj₁ (M' , r) =
  inj₁ (_ , context (promise op ∣ p ↦ M `in [-]) r)
... | inj₂ (comp R) =
  inj₂ (comp (promise R))
... | inj₂ (signal {_} {_} {_} {_} {q} {V} {M'} R) =
  inj₁ (_ , promise-↑ p q V M M')
progress (await ` x until M) =
  inj₂ (comp (awaiting await))
progress (await ⟨ V ⟩ until M) =
  inj₁ (_ , await-promise V M)
progress (coerce p q M) with progress M
... | inj₁ (M' , r) =
  inj₁ (_ , context (coerce p q [-]) r)
... | inj₂ (comp (return V)) =
  inj₁ (_ , coerce-return V)
... | inj₂ (comp (promise {_} {_} {_} {_} {_} {_} {op'} {r} {M'} {M''} R)) =
  inj₁ (_ , coerce-promise r M' M'')
... | inj₂ (comp (awaiting R)) =
  inj₂ (comp (awaiting (coerce R)))
... | inj₂ (signal {_} {_} {_} {_} {r} {V} {M'} R) =
  inj₁ (_ , coerce-↑ r V M')

-- PROGRESS THEOREM FOR CLOSED COMPUTATIONS

{- COROLLARY 3.4 -}

closed-progress : {C : CType} →
                  (M : [] ⊢M⦂ C) →
                  --------------------------
                  (Σ[ N ∈ [] ⊢M⦂ C ] (M ↝ N)
                   ⊎
                   CompResult⟨ [] ∣ M ⟩)

closed-progress M =
  progress M


-- 2014-05-27 Jesper and Andreas

postulate
  A : Set
  a : A → A → A

{-# BUILTIN REWRITE a #-}

-- Expected error:

-- a  does not have the right type for a rewriting relation
-- because its type does not end in a sort, but in  A
-- when checking the pragma BUILTIN REWRITE a


{-# OPTIONS --safe #-}

postulate F : Set → Set

{-# POLARITY F ++ #-}


-- Andreas, 2020-06-17, issue #4135
-- Do not allow meta-solving during projection disambiguation!

data Bool : Set where
  true false : Bool

module Foo (b : Bool) where
  record R : Set where
    field f : Bool
  open R public

open module True  = Foo true
open module False = Foo false

test : Foo.R {!!}
test .f = {!!}

-- WAS: succeeds with constraint ?0 := true
-- C-c C-=

-- Expected error:
-- Ambiguous projection f.
-- It could refer to any of
--   True.f (introduced at <open module True>)
--   False.f (introduced at <open module False>)
-- when checking the clause left hand side
-- test .f


data ⊤ : Set where
  t : ⊤

data ⊤⊤ : Set where
  tt : ⊤⊤

module M (x : ⊤⊤) where

  instance
    top : ⊤
    top = t

search : ∀ {ℓ} {t : Set ℓ} {{_ : t}} → t
search {{p}} = p

-- no instance is in scope, and none is found
-- correct : ⊤
-- correct = search

someDef : ⊤
someDef = top
  where
    open M tt

-- incorrect! there should be no instance available.
leak : ⊤
leak = search


-- Andreas, 2022-03-25, issue #5838, inconsistency in Cubical Agda.
-- Reported by Tom Jack: variant of test/Fail/Issue5838.agda.

{-# OPTIONS --safe --cubical #-}

open import Agda.Builtin.Bool
open import Agda.Builtin.Sigma

open import Agda.Primitive.Cubical
open import Agda.Primitive.Cubical public
  renaming ( primIMin       to _∧_  -- I → I → I
           ; primIMax       to _∨_  -- I → I → I
           ; primINeg       to ~_   -- I → I
           ; isOneEmpty     to empty
           ; primComp       to comp
           ; primHComp      to hcomp
           ; primTransp     to transp
           ; itIsOne        to 1=1 )

open import Agda.Builtin.Cubical.Path
open import Agda.Builtin.Cubical.Glue; open Helpers public
open import Agda.Builtin.Cubical.Sub public
  renaming ( inc to inS
           ; primSubOut to outS
           )

---------------------------------------------------------------------------
-- Foundations

Type = Set

Path : (A : Type) → A → A → Type
Path A a b = PathP (λ _ → A) a b

isProp : Type → Type
isProp A = (x y : A) → x ≡ y

toPathP : {A : I → Type} {x : A i0} {y : A i1} → transp (λ i → A i) i0 x ≡ y → PathP A x y
toPathP {A = A} {x = x} p i =
  hcomp (λ j → λ { (i = i0) → x
                 ; (i = i1) → p j })
    (transp (λ j → A (i ∧ j)) (~ i) x)

isProp→PathP : ∀ {B : I → Type} → ((i : I) → isProp (B i))
               → (b0 : B i0) (b1 : B i1)
               → PathP (λ i → B i) b0 b1
isProp→PathP hB b0 b1 = toPathP (hB _ _ _)

---------------------------------------------------------------------------
-- Equivalence

-- The identity equivalence
idIsEquiv : (A : Type) → isEquiv (λ (x : A) → x)
idIsEquiv A .equiv-proof y =
  (y , refl) , λ z i → z .snd (~ i) , λ j → z .snd (~ i ∨ j)

idEquiv : (A : Type) → A ≃ A
idEquiv A .fst = λ x → x
idEquiv A .snd = idIsEquiv A

isPropIsEquiv : {A B : Type} (f : A → B) → isProp (isEquiv f)
isPropIsEquiv f p q i .equiv-proof y =
  let p2 = p .equiv-proof y .snd
      q2 = q .equiv-proof y .snd
  in p2 (q .equiv-proof y .fst) i
   , λ w j → hcomp (λ k → λ { (i = i0) → p2 w j
                            ; (i = i1) → q2 w (j ∨ ~ k)
                            ; (j = i0) → p2 (q2 w (~ k)) i
                            ; (j = i1) → w })
                   (p2 w (i ∨ j))

equivEq : {A B : Type} {e f : A ≃ B} → (h : e .fst ≡ f .fst) → e ≡ f
equivEq {e = e} {f = f} h i =
  h i , isProp→PathP (λ i → isPropIsEquiv (h i)) (e .snd) (f .snd) i

---------------------------------------------------------------------------
-- Univalence

Glue : (A : Type) {φ : I}
       → (Te : Partial φ (Σ Type λ T → T ≃ A))
       → Type
Glue A Te = primGlue A (λ x → Te x .fst) (λ x → Te x .snd)

ua : ∀ {A B : Type} → A ≃ B → A ≡ B
ua {A = A} {B = B} e i = Glue B (λ { (i = i0) → (A , e)
                                   ; (i = i1) → (B , idEquiv B) })

---------------------------------------------------------------------------
-- Isomorphisms

record Iso (A B : Type) : Type where
  no-eta-equality
  constructor iso
  field
    fun : A → B
    inv : B → A
    rightInv : ∀ b → fun (inv b) ≡ b
    leftInv  : ∀ a → inv (fun a) ≡ a

-- Any iso is an equivalence
module _ {A B : Type} (i : Iso A B) where
  open Iso i renaming ( fun to f
                      ; inv to g
                      ; rightInv to s
                      ; leftInv to t)

  private
    module _ (y : B) (x0 x1 : A) (p0 : f x0 ≡ y) (p1 : f x1 ≡ y) where
      fill0 : I → I → A
      fill0 i = hfill (λ k → λ { (i = i1) → t x0 k
                               ; (i = i0) → g y })
                      (inS (g (p0 (~ i))))

      fill1 : I → I → A
      fill1 i = hfill (λ k → λ { (i = i1) → t x1 k
                               ; (i = i0) → g y })
                      (inS (g (p1 (~ i))))

      fill2 : I → I → A
      fill2 i = hfill (λ k → λ { (i = i1) → fill1 k i1
                               ; (i = i0) → fill0 k i1 })
                      (inS (g y))

      p : x0 ≡ x1
      p i = fill2 i i1

      sq : I → I → A
      sq i j = hcomp (λ k → λ { (i = i1) → fill1 j (~ k)
                              ; (i = i0) → fill0 j (~ k)
                              ; (j = i1) → t (fill2 i i1) (~ k)
                              ; (j = i0) → g y })
                     (fill2 i j)

      sq1 : I → I → B
      sq1 i j = hcomp (λ k → λ { (i = i1) → s (p1 (~ j)) k
                               ; (i = i0) → s (p0 (~ j)) k
                               ; (j = i1) → s (f (p i)) k
                               ; (j = i0) → s y k })
                      (f (sq i j))

      lemIso : (x0 , p0) ≡ (x1 , p1)
      lemIso i .fst = p i
      lemIso i .snd = λ j → sq1 i (~ j)

  isoToIsEquiv : isEquiv f
  isoToIsEquiv .equiv-proof y .fst .fst = g y
  isoToIsEquiv .equiv-proof y .fst .snd = s y
  isoToIsEquiv .equiv-proof y .snd z = lemIso y (g y) (fst z) (s y) (snd z)

  isoToEquiv : A ≃ B
  isoToEquiv .fst = _
  isoToEquiv .snd = isoToIsEquiv

---------------------------------------------------------------------------
-- Booleans

notEquiv : Bool ≃ Bool
notEquiv = isoToEquiv (iso not not notnot notnot)
  where
  not : Bool → Bool
  not true = false
  not false = true

  notnot : ∀ x → not (not x) ≡ x
  notnot true  = refl
  notnot false = refl

---------------------------------------------------------------------------
-- Circle

data S¹ : Type where
  base : S¹
  loop : base ≡ base

-- rot, used in the Hopf fibration
-- we will denote rotation by _·_
-- it is called μ in the HoTT-book in "8.5.2 The Hopf construction"

rotLoop : (a : S¹) → a ≡ a
rotLoop base       = loop
rotLoop (loop i) j =
  hcomp (λ k → λ { (i = i0) → loop (j ∨ ~ k)
                 ; (i = i1) → loop (j ∧ k)
                 ; (j = i0) → loop (i ∨ ~ k)
                 ; (j = i1) → loop (i ∧ k)}) base

---------------------------------------------------------------------------
-- Inconsistency distilled from #5838

-- twisted-square : Path (Path Type S¹ S¹) refl refl  -- needs Path in Type₁
twisted-square : (i j : I) → Type  -- SLOW
twisted-square i j = Glue S¹ λ
  { (i = i0) → S¹ , equivEq {e = idEquiv S¹} {f = idEquiv S¹} (λ k x → rotLoop x k) j
  ; (i = i1) → S¹ , idEquiv S¹
  ; (j = i0) → S¹ , idEquiv S¹
  ; (j = i1) → S¹ , idEquiv S¹
  }

DoubleCover : S¹ → Type
DoubleCover base     = Bool
DoubleCover (loop i) = ua notEquiv i

-- @tomjack writes (2022-03-24):
-- Here is an addendum to Issue5838.agda which shows (I think?)
-- that compHCompU DoTransp also needs to be fixed:

twisted-square' : (i j : I) → Type
twisted-square' i j =
  hcomp (λ k → λ { (i = i0) → twisted-square k j
                 ; (i = i1) → S¹
                 ; (j = i0) → S¹
                 ; (j = i1) → S¹
                 })
        S¹

-- Exploit an invalid reduction of transp on composition for the universe.

bad' : true ≡ false
bad' k = transp (λ i → DoubleCover (transp (λ j → twisted-square' i j) (k ∧ (i ∨ ~ i)) base)) i0 false

-- Expected:
-- false != true of type Bool
-- when checking the definition of bad'

-- This is test/Fail/Issue5838:
-- Exploit an invalid reduction of transp on Glue.

bad : true ≡ false
bad k = transp (λ i → DoubleCover (transp (λ j → twisted-square i j) (k ∧ (i ∨ ~ i)) base)) i0 false

-- Expected:
-- false != true of type Bool
-- when checking the definition of bad


open import Prelude hiding (id; Bool; _∷_; [])

module Examples.Infinite where
open import Implicits.Syntax
open import Implicits.WellTyped
open import Implicits.Substitutions
open import Implicits.Syntax.Type.Unification
open import Implicits.Resolution.Infinite.Resolution
open TypingRules _⊢ᵣ_
open import Data.Maybe
open import Data.List

tc-bool = 0
tc-int = 1

Bool : ∀ {n} → Type n
Bool = simpl (tc tc-bool)

Int : ∀ {n} → Type n
Int = simpl (tc tc-int)

module Ex₁ where
  Δ : ICtx zero
  Δ = (∀' (TVar zero ⇒ TVar zero)) ∷ []

  p : Δ ⊢ᵣ (Int ⇒ Int)
  p = r-iabs (r-simp (there (here refl))
    (i-tabs
      Int
        (i-iabs (r-simp (here refl) (i-simp (tc tc-int))) (i-simp (tc tc-int)))))

module Ex₂ where

  implicitly : ∀ {ν n} → Term ν n
  implicitly = Λ (ρ α (var zero))
    where
      α = TVar zero

  Implicitly : ∀ {ν n} {K : Ktx ν n} → K ⊢ implicitly ∈ (∀' (TVar zero ⇒ TVar zero))
  Implicitly = Λ (ρ (ua-simp [] All.[]) (var zero))


-- {-# OPTIONS -v tc:10 -v tc.inj:100 #-}
-- 2013-02-18 reported by rotsor

module Issue796o where

data U : Set where
  a b : U

data A : Set where
data B : Set where

abstract
  A' B' : Set

  A' = A
  B' = B  -- fails if changed to A.  Should always fail.

[_] : U → Set
[_] a = A'
[_] b = B'

f : ∀ u → [ u ] → U
f u _ = u

postulate x : A'

zzz = f _ x


module Unsolved-meta-in-module-telescope (A : _) where


{-# OPTIONS --safe #-}

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Properties.Conversion {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

open import Definition.Untyped
open import Definition.Typed
open import Definition.Typed.RedSteps
open import Definition.Typed.Reduction
import Definition.Typed.Weakening as W
open import Definition.Typed.Properties
open import Definition.LogicalRelation
open import Definition.LogicalRelation.ShapeView
open import Definition.LogicalRelation.Irrelevance

open import Tools.Product
import Tools.PropositionalEquality as PE

import Data.Fin as Fin
import Data.Nat as Nat

-- Conversion of syntactic reduction closures.
convRed:*: : ∀ {t u A B Γ l} → Γ ⊢ t :⇒*: u ∷ A ^ l → Γ ⊢ A ≡ B ^ [ ! , l ] → Γ ⊢ t :⇒*: u ∷ B ^ l
convRed:*: [[ ⊢t , ⊢u , d ]] A≡B = [[ conv ⊢t  A≡B , conv ⊢u  A≡B , conv* d  A≡B ]]

-- helper functions for the universe
convTermTUniv :  ∀ {Γ A B t l l' r ll l< d r' ll' l<' el' d'}
                      (er : r PE.≡ r') (ellll' : ll PE.≡ ll') →
                      Γ ⊩⟨ l ⟩  t ∷ A ^ [ ! , next ll ] / Uᵣ (Uᵣ r ll l< PE.refl d) →
                      Γ ⊩⟨ l' ⟩ t ∷ B ^ [ ! , next ll ] / Uᵣ (Uᵣ r' ll' l<' el' d')
convTermTUniv {l< = l<} {l<' = l<'} {d' = d'} er ellll' (Uₜ K d typeK K≡K [t]) =
    let dd = PE.subst (λ x → _ ⊢ _ :⇒*: Univ x _ ^ _) (PE.sym er) (PE.subst (λ x → _ ⊢ _ :⇒*: Univ _ x ^ [ ! , next x ]) (PE.sym ellll') d') in
    reduction-irrelevant-Univ {l< = l<} {l<' = l<'} {el = PE.refl} {D = dd} {D' = d'} er (Uₜ K d typeK K≡K [t])

convEqTermTUniv : ∀ {Γ A B t u l r ll l< d dd} →
                    Γ ⊩⟨ l ⟩ t ≡ u ∷ A ^ [ ! , next ll ] / Uᵣ (Uᵣ r ll l< PE.refl d) →
                    Γ ⊩⟨ l ⟩ t ≡ u ∷ B ^ [ ! , next ll ] / Uᵣ (Uᵣ r ll l< PE.refl dd)
convEqTermTUniv {l = ι ¹} {r = r} {⁰} (Uₜ₌ [t] [u] A≡B [t≡u]) =
                   Uₜ₌ (convTermTUniv PE.refl PE.refl [t]) (convTermTUniv PE.refl PE.refl [u]) A≡B [t≡u]
convEqTermTUniv {l = ∞} {r = r} {¹} (Uₜ₌ [t] [u] A≡B [t≡u]) =
                   Uₜ₌ (convTermTUniv PE.refl PE.refl [t]) (convTermTUniv PE.refl PE.refl [u]) A≡B [t≡u]

mutual
  -- Helper function for conversion of terms converting from left to right.

  convTermT₁ : ∀ {Γ A B r t l l′} {[A] : Γ ⊩⟨ l ⟩ A ^ r} {[B] : Γ ⊩⟨ l′ ⟩ B ^ r}
            → ShapeView Γ l l′ A B r r [A] [B]
            → Γ ⊩⟨ l ⟩  A ≡ B ^ r / [A]
            → Γ ⊩⟨ l ⟩  t ∷ A ^ r / [A]
            → Γ ⊩⟨ l′ ⟩ t ∷ B ^ r / [B]

  convTermT₁ (ℕᵥ D D′) A≡B t = t
  convTermT₁ (Emptyᵥ D D′) A≡B t = t

  convTermT₁ {r = [ ! , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M) (neₜ k d (neNfₜ neK₂ ⊢k k≡k)) =
    let K≡K₁ = PE.subst (λ x → _ ⊢ _ ≡ x ^ _)
                        (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                        (≅-eq (~-to-≅ K≡M))
    in  neₜ k (convRed:*: d K≡K₁)
              (neNfₜ neK₂ (conv ⊢k K≡K₁) (~-conv k≡k K≡K₁))
  convTermT₁ {r = [ % , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M)
             (neₜ d) = let K≡K₁ = PE.subst (λ x → _ ⊢ _ ≡ x ^ _)
                                          (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                                          (≅-eq (~-to-≅ K≡M))
                       in neₜ (conv d (reduction  (red D) (red D₁) (ne neK) (ne neK₁) K≡K₁))
  convTermT₁ {Γ = Γ} {r = [ ! , ι ll ]} (Πᵥ (Πᵣ rF lF lG _ _ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                         (Πᵣ rF₁ lF₁ lG₁ _ _ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
             (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
             (Πₜ f d funcF f≡f [f] [f]₁) =
    let ΠF₁G₁≡ΠF′G′   = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
        F₁≡F′ , rF₁≡rF′ , lF₁≡lF′ , G₁≡G′ , lG₁≡lG′ , lΠ≡lΠ₁ = Π-PE-injectivity ΠF₁G₁≡ΠF′G′
        ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ ! , ι ll ]) (PE.sym ΠF₁G₁≡ΠF′G′)
                             (≅-eq A≡B)
    in  Πₜ f (convRed:*: d ΠFG≡ΠF₁G₁) funcF (≅-conv f≡f ΠFG≡ΠF₁G₁)
           (λ {ρ} [ρ] ⊢Δ [a] [b] [a≡b] →
              let [F≡F₁] = irrelevanceEqR′ (PE.cong (wk ρ) (PE.sym F₁≡F′))
                                           ([F] [ρ] ⊢Δ) ([F≡F′] [ρ] ⊢Δ)
                  [a]₁ = convTerm₂′ PE.refl (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a]
                  [b]₁ = convTerm₂′ PE.refl (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [b]
                  [a≡b]₁ = convEqTerm₂′ (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a≡b]
                  [G≡G₁] = irrelevanceEqR′ (PE.cong (λ x → wk (lift ρ) x [ _ ])
                                                    (PE.sym G₁≡G′))
                                           ([G] [ρ] ⊢Δ [a]₁)
                                           ([G≡G′] [ρ] ⊢Δ [a]₁)
              in  convEqTerm₁′ PE.refl (PE.cong ι (PE.sym lG₁≡lG′)) ([G] [ρ] ⊢Δ [a]₁) ([G]₁ [ρ] ⊢Δ [a]) [G≡G₁]
                              ([f] [ρ] ⊢Δ [a]₁ [b]₁ [a≡b]₁))
          (λ {ρ} [ρ] ⊢Δ [a] →
             let [F≡F₁] = irrelevanceEqR′ (PE.cong (wk ρ) (PE.sym F₁≡F′))
                                          ([F] [ρ] ⊢Δ) ([F≡F′] [ρ] ⊢Δ)
                 [a]₁ = convTerm₂′ PE.refl (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a]
                 [G≡G₁] = irrelevanceEqR′ (PE.cong (λ x → wk (lift ρ) x [ _ ])
                                                   (PE.sym G₁≡G′))
                                          ([G] [ρ] ⊢Δ [a]₁)
                                          ([G≡G′] [ρ] ⊢Δ [a]₁)
             in  convTerm₁′ PE.refl (PE.cong ι (PE.sym lG₁≡lG′)) ([G] [ρ] ⊢Δ [a]₁) ([G]₁ [ρ] ⊢Δ [a]) [G≡G₁] ([f]₁ [ρ] ⊢Δ [a]₁))
  convTermT₁ {Γ = Γ} {r = [ % , ι ll ]} (Πᵥ (Πᵣ rF lF lG _ _ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                         (Πᵣ rF₁ lF₁ lG₁ _ _ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
             (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
             d = let ΠF₁G₁≡ΠF′G′   = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
                     F₁≡F′ , rF₁≡rF′ , lF₁≡lF′ , G₁≡G′ , lG₁≡lG′ = Π-PE-injectivity ΠF₁G₁≡ΠF′G′
                     ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ % , ι ll ]) (PE.sym ΠF₁G₁≡ΠF′G′)
                                          (≅-eq A≡B)
                 in conv d ΠFG≡ΠF₁G₁
  convTermT₁ {Γ = Γ} {r = [ % , ll ]} (∃ᵥ (∃ᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                         (∃ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
             (∃₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
             d = let ∃F₁G₁≡∃F′G′   = whrDet* (red D₁ , ∃ₙ) (D′ , ∃ₙ)
                     F₁≡F′ , G₁≡G′ = ∃-PE-injectivity ∃F₁G₁≡∃F′G′
                     ∃FG≡∃F₁G₁ = PE.subst (λ x → Γ ⊢ ∃ F ▹ G ≡ x ^ [ % , ll ]) (PE.sym ∃F₁G₁≡∃F′G′)
                                          (≅-eq A≡B)
                 in conv d ∃FG≡∃F₁G₁
  convTermT₁ (Uᵥ (Uᵣ r l l< PE.refl d) (Uᵣ r' l' l<' el' d')) A≡B X =
    let U≡U   = whrDet* (A≡B , Uₙ) (red d' , Uₙ)
        r≡r , l≡l = Univ-PE-injectivity U≡U
    in convTermTUniv r≡r l≡l X
  convTermT₁ (emb⁰¹ X) A≡B t = convTermT₁ X A≡B t
  convTermT₁ (emb¹⁰ X) A≡B t = convTermT₁ X A≡B t
  convTermT₁ (emb¹∞ X) A≡B t = convTermT₁ X A≡B t
  convTermT₁ (emb∞¹ X) A≡B t = convTermT₁ X A≡B t

  -- Helper function for conversion of terms converting from right to left.
  convTermT₂ : ∀ {l l′ Γ A B r t} {[A] : Γ ⊩⟨ l ⟩ A ^ r} {[B] : Γ ⊩⟨ l′ ⟩ B ^ r}
           → ShapeView Γ l l′ A B r r [A] [B]
           → Γ ⊩⟨ l ⟩  A ≡ B ^ r / [A]
           → Γ ⊩⟨ l′ ⟩ t ∷ B ^ r / [B]
           → Γ ⊩⟨ l ⟩  t ∷ A ^ r / [A]
  convTermT₂ (ℕᵥ D D′) A≡B t = t
  convTermT₂ (Emptyᵥ D D′) A≡B t = t
  convTermT₂ {r = [ ! , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M)
             (neₜ k d (neNfₜ neK₂ ⊢k k≡k)) =
    let K₁≡K = PE.subst (λ x → _ ⊢ x ≡ _ ^ _)
                        (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                        (sym (≅-eq (~-to-≅ K≡M)))
    in  neₜ k (convRed:*: d K₁≡K)
            (neNfₜ neK₂ (conv ⊢k K₁≡K) (~-conv k≡k K₁≡K))
  convTermT₂ {r = [ % , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M)
             (neₜ d) = let K₁≡K = PE.subst (λ x → _ ⊢ x ≡ _ ^ _)
                                           (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                                           (sym (≅-eq (~-to-≅ K≡M)))
                       in neₜ (conv d (reduction  (red D₁) (red D) (ne neK₁) (ne neK) K₁≡K))
  convTermT₂ {Γ = Γ} {r = [ ! , ι ll ]} (Πᵥ (Πᵣ rF lF lG _ _ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                         (Πᵣ rF₁ lF₁ lG₁ _ _ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
             (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
             (Πₜ f d funcF f≡f [f] [f]₁) =
    let ΠF₁G₁≡ΠF′G′   = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
        F₁≡F′ , rF₁≡rF′ , lF₁≡lF′ , G₁≡G′ , lG₁≡lG′ , lΠ≡lΠ₁ = Π-PE-injectivity ΠF₁G₁≡ΠF′G′
        ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ ! , ι ll ])
                             (PE.sym ΠF₁G₁≡ΠF′G′) (≅-eq A≡B)
    in  Πₜ f (convRed:*: d (sym ΠFG≡ΠF₁G₁)) funcF (≅-conv f≡f (sym ΠFG≡ΠF₁G₁))
           (λ {ρ} [ρ] ⊢Δ [a] [b] [a≡b] →
              let [F≡F₁] = irrelevanceEqR′ (PE.cong (wk ρ) (PE.sym F₁≡F′))
                                           ([F] [ρ] ⊢Δ) ([F≡F′] [ρ] ⊢Δ)
                  [a]₁ = convTerm₁′ (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a]
                  [b]₁ = convTerm₁′ (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [b]
                  [a≡b]₁ = convEqTerm₁′ (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a≡b]
                  [G≡G₁] = irrelevanceEqR′ (PE.cong (λ x → wk (lift ρ) x [ _ ])
                                                    (PE.sym G₁≡G′))
                                           ([G] [ρ] ⊢Δ [a])
                                           ([G≡G′] [ρ] ⊢Δ [a])
              in  convEqTerm₂′ PE.refl (PE.cong ι (PE.sym lG₁≡lG′)) ([G] [ρ] ⊢Δ [a]) ([G]₁ [ρ] ⊢Δ [a]₁)
                              [G≡G₁] ([f] [ρ] ⊢Δ [a]₁ [b]₁ [a≡b]₁))
           (λ {ρ} [ρ] ⊢Δ [a] →
              let [F≡F₁] = irrelevanceEqR′ (PE.cong (wk ρ) (PE.sym F₁≡F′))
                                           ([F] [ρ] ⊢Δ) ([F≡F′] [ρ] ⊢Δ)
                  [a]₁ = convTerm₁′ (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a]
                  [G≡G₁] = irrelevanceEqR′ (PE.cong (λ x → wk (lift ρ) x [ _ ])
                                                    (PE.sym G₁≡G′))
                                           ([G] [ρ] ⊢Δ [a])
                                           ([G≡G′] [ρ] ⊢Δ [a])
              in  convTerm₂′ PE.refl PE.refl (PE.cong ι (PE.sym lG₁≡lG′)) ([G] [ρ] ⊢Δ [a]) ([G]₁ [ρ] ⊢Δ [a]₁)
                            [G≡G₁] ([f]₁ [ρ] ⊢Δ [a]₁))
  convTermT₂ {Γ = Γ} {r = [ % , ι ll ]} (Πᵥ (Πᵣ rF lF lG _ _ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                         (Πᵣ rF₁ lF₁ lG₁ _ _ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
             (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
             d = let ΠF₁G₁≡ΠF′G′   = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
                     F₁≡F′ , rF₁≡rF′ , lF₁≡lF′ , G₁≡G′ , lG₁≡lG′ = Π-PE-injectivity ΠF₁G₁≡ΠF′G′
                     ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ % , ι ll ])
                                          (PE.sym ΠF₁G₁≡ΠF′G′) (≅-eq A≡B)
                 in  conv d (sym ΠFG≡ΠF₁G₁)
  convTermT₂ {Γ = Γ} {r = [ % , ll ]} (∃ᵥ (∃ᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                         (∃ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
             (∃₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
             d = let ∃F₁G₁≡∃F′G′   = whrDet* (red D₁ , ∃ₙ) (D′ , ∃ₙ)
                     F₁≡F′ ,  G₁≡G′ = ∃-PE-injectivity ∃F₁G₁≡∃F′G′
                     ∃FG≡∃F₁G₁ = PE.subst (λ x → Γ ⊢ ∃ F ▹ G ≡ x ^ [ % , ll ])
                                          (PE.sym ∃F₁G₁≡∃F′G′) (≅-eq A≡B)
                 in  conv d (sym ∃FG≡∃F₁G₁)
  convTermT₂ (Uᵥ (Uᵣ r l l< el d) (Uᵣ r' l' l<' PE.refl d')) A≡B X =
    let U≡U   = whrDet* (A≡B , Uₙ) (red d' , Uₙ)
        r≡r , l≡l = Univ-PE-injectivity U≡U
    in convTermTUniv (PE.sym r≡r) (PE.sym l≡l) X
  convTermT₂ (emb⁰¹ X) A≡B t = convTermT₂ X A≡B t
  convTermT₂ (emb¹⁰ X) A≡B t = convTermT₂ X A≡B t
  convTermT₂ (emb¹∞ X) A≡B t = convTermT₂ X A≡B t
  convTermT₂ (emb∞¹ X) A≡B t = convTermT₂ X A≡B t

  -- Conversion of terms converting from left to right.
  convTerm₁ : ∀ {Γ A B r ll t l l′} ([A] : Γ ⊩⟨ l ⟩ A ^ [ r , ll ]) ([B] : Γ ⊩⟨ l′ ⟩ B ^ [ r , ll ])
            → Γ ⊩⟨ l ⟩  A ≡ B ^ [ r , ll ] / [A]
            → Γ ⊩⟨ l ⟩  t ∷ A ^ [ r , ll ] / [A]
            → Γ ⊩⟨ l′ ⟩ t ∷ B ^ [ r , ll ] / [B]
  convTerm₁ [A] [B] A≡B t = convTermT₁ (goodCases [A] [B] A≡B) A≡B t

  -- Conversion of terms converting from left to right. with PE
  convTerm₁′ : ∀ {Γ A B r r' ll ll' t l l′} (eq : r PE.≡ r') (eql : ll PE.≡ ll')
                 ([A] : Γ ⊩⟨ l ⟩ A ^ [ r , ll ]) ([B] : Γ ⊩⟨ l′ ⟩ B ^ [ r' , ll' ])
            → Γ ⊩⟨ l ⟩  A ≡ B ^ [ r , ll ] / [A]
            → Γ ⊩⟨ l ⟩  t ∷ A ^ [ r , ll ] / [A]
            → Γ ⊩⟨ l′ ⟩ t ∷ B ^ [ r' , ll' ] / [B]
  convTerm₁′ PE.refl PE.refl [A] [B] A≡B t = convTerm₁ [A] [B] A≡B t

  -- Conversion of terms converting from right to left.
  convTerm₂ : ∀ {Γ A B r t l l′} ([A] : Γ ⊩⟨ l ⟩ A ^ r) ([B] : Γ ⊩⟨ l′ ⟩ B ^ r)
          → Γ ⊩⟨ l ⟩  A ≡ B ^ r / [A]
          → Γ ⊩⟨ l′ ⟩ t ∷ B ^ r / [B]
          → Γ ⊩⟨ l ⟩  t ∷ A ^ r / [A]
  convTerm₂ [A] [B] A≡B t = convTermT₂ (goodCases [A] [B] A≡B) A≡B t

  -- Conversion of terms converting from right to left
  -- with some propsitionally equal types.
  convTerm₂′ : ∀ {Γ A r r' ll ll' B B′ t l l′} → B PE.≡ B′ → r PE.≡ r' → ll PE.≡ ll'
          → ([A] : Γ ⊩⟨ l ⟩ A ^ [ r , ll ] ) ([B] : Γ ⊩⟨ l′ ⟩ B ^ [ r' , ll' ])
          → Γ ⊩⟨ l ⟩  A ≡ B′ ^ [ r , ll ] / [A]
          → Γ ⊩⟨ l′ ⟩ t ∷ B ^ [ r' , ll' ] / [B]
          → Γ ⊩⟨ l ⟩  t ∷ A ^ [ r , ll ] / [A]
  convTerm₂′ PE.refl PE.refl PE.refl [A] [B] A≡B t = convTerm₂ [A] [B] A≡B t

  -- Helper function for conversion of term equality converting from left to right.
  convEqTermT₁ : ∀ {l l′ Γ A B r t u} {[A] : Γ ⊩⟨ l ⟩ A ^ r} {[B] : Γ ⊩⟨ l′ ⟩ B ^ r}
               → ShapeView Γ l l′ A B r r [A] [B]
               → Γ ⊩⟨ l ⟩  A ≡ B ^ r / [A]
               → Γ ⊩⟨ l ⟩  t ≡ u ∷ A ^ r / [A]
               → Γ ⊩⟨ l′ ⟩ t ≡ u ∷ B ^ r / [B]
  convEqTermT₁ (ℕᵥ D D′) A≡B t≡u = t≡u
  convEqTermT₁ (Emptyᵥ D D′) A≡B t≡u = t≡u
  convEqTermT₁ {r = [ ! , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M)
               (neₜ₌ k m d d′ (neNfₜ₌ neK₂ neM₁ k≡m)) =
    let K≡K₁ = PE.subst (λ x → _ ⊢ _ ≡ x ^ _)
                        (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                        (≅-eq (~-to-≅ K≡M))
    in  neₜ₌ k m (convRed:*: d K≡K₁)
                 (convRed:*: d′ K≡K₁)
                 (neNfₜ₌ neK₂ neM₁ (~-conv k≡m K≡K₁))
  convEqTermT₁ {r = [ % , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M)
               (neₜ₌ d d′) =
    let K≡K₁ = PE.subst (λ x → _ ⊢ _ ≡ x ^ _)
                        (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                        (≅-eq (~-to-≅ K≡M))
    in neₜ₌ (conv d (reduction  (red D) (red D₁) (ne neK) (ne neK₁) K≡K₁))
            (conv d′ (reduction  (red D) (red D₁) (ne neK) (ne neK₁) K≡K₁))
  convEqTermT₁ {Γ = Γ} {r = [ ! , ι ll ]} (Πᵥ (Πᵣ rF lF lG lF≤ lG≤  F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                           (Πᵣ rF₁ lF₁ lG₁ lF₁≤ lG₁≤  F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
               (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
               (Πₜ₌ f g d d′ funcF funcG t≡u [t] [u] [t≡u]) =
    let [A] = Πᵣ′ rF lF lG lF≤ lG≤ F G D ⊢F ⊢G A≡A [F] [G] G-ext
        [B] = Πᵣ′ rF₁ lF₁ lG₁ lF₁≤ lG₁≤ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁
        [A≡B] = Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]
        ΠF₁G₁≡ΠF′G′ = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
        ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ ! , ι ll ])
                             (PE.sym ΠF₁G₁≡ΠF′G′) (≅-eq A≡B)
    in  Πₜ₌ f g (convRed:*: d ΠFG≡ΠF₁G₁) (convRed:*: d′ ΠFG≡ΠF₁G₁)
            funcF funcG (≅-conv t≡u ΠFG≡ΠF₁G₁)
            (convTerm₁ [A] [B] [A≡B] [t]) (convTerm₁ [A] [B] [A≡B] [u])
            (λ {ρ} [ρ] ⊢Δ [a] →
               let F₁≡F′ , rF₁≡rF′ , lF₁≡lF′ , G₁≡G′ , lG₁≡lG′ , lΠ≡lΠ₁ = Π-PE-injectivity (whrDet* (red D₁ , Πₙ) (D′ , Πₙ))
                   [F≡F₁] = irrelevanceEqR′ (PE.cong (wk ρ) (PE.sym F₁≡F′))
                                            ([F] [ρ] ⊢Δ) ([F≡F′] [ρ] ⊢Δ)
                   [a]₁ = convTerm₂′ PE.refl (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a]
                   [G≡G₁] = irrelevanceEqR′ (PE.cong (λ x → wk (lift ρ) x [ _ ])
                                                     (PE.sym G₁≡G′))
                                            ([G] [ρ] ⊢Δ [a]₁)
                                            ([G≡G′] [ρ] ⊢Δ [a]₁)
               in  convEqTerm₁′ PE.refl (PE.cong ι (PE.sym lG₁≡lG′)) ([G] [ρ] ⊢Δ [a]₁) ([G]₁ [ρ] ⊢Δ [a])
                               [G≡G₁] ([t≡u] [ρ] ⊢Δ [a]₁))
  convEqTermT₁ {Γ = Γ} {r = [ % , ι ll ]} (Πᵥ (Πᵣ rF lF lG _ _ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                           (Πᵣ rF₁ lF₁ lG₁ _ _ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
               (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
               (d , d′) = let ΠF₁G₁≡ΠF′G′ = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
                              ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ % , ι ll ])
                                                   (PE.sym ΠF₁G₁≡ΠF′G′) (≅-eq A≡B)
                          in conv d ΠFG≡ΠF₁G₁ , conv d′ ΠFG≡ΠF₁G₁
  convEqTermT₁ {Γ = Γ} {r = [ % , ll ]} (∃ᵥ (∃ᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                           (∃ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
               (∃₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
               (d , d′) = let ∃F₁G₁≡∃F′G′ = whrDet* (red D₁ , ∃ₙ) (D′ , ∃ₙ)
                              ∃FG≡∃F₁G₁ = PE.subst (λ x → Γ ⊢ ∃ F ▹ G ≡ x ^ [ % , ll ])
                                                   (PE.sym ∃F₁G₁≡∃F′G′) (≅-eq A≡B)
                          in (conv d ∃FG≡∃F₁G₁) , conv d′ ∃FG≡∃F₁G₁
  convEqTermT₁ (Uᵥ (Uᵣ r ll l< PE.refl d) (Uᵣ r' ll' l<' el' d')) A≡B X =
    let U≡U   = whrDet* (A≡B , Uₙ) (red d' , Uₙ)
        r≡r , l≡l = Univ-PE-injectivity U≡U
        dd = PE.subst (λ x → _ ⊢ _ :⇒*: Univ x _ ^ _) (PE.sym r≡r) (PE.subst (λ x → _ ⊢ _ :⇒*: Univ _ x ^ [ ! , next x ]) (PE.sym l≡l) d')
    in reduction-irrelevant-Univ= {l< = l<} {l<' = l<'} {el = PE.refl} {el' = el'} {D = dd} {D' = d'} r≡r (convEqTermTUniv X)
  convEqTermT₁ (emb⁰¹ X) A≡B t≡u = convEqTermT₁ X A≡B t≡u
  convEqTermT₁ (emb¹⁰ X) A≡B t≡u = convEqTermT₁ X A≡B t≡u
  convEqTermT₁ (emb¹∞ X) A≡B t≡u = convEqTermT₁ X A≡B t≡u
  convEqTermT₁ (emb∞¹ X) A≡B t≡u = convEqTermT₁ X A≡B t≡u

  -- Helper function for conversion of term equality converting from right to left.
  convEqTermT₂ : ∀ {l l′ Γ A B t u r} {[A] : Γ ⊩⟨ l ⟩ A ^ r} {[B] : Γ ⊩⟨ l′ ⟩ B ^ r}
             → ShapeView Γ l l′ A B r r [A] [B]
             → Γ ⊩⟨ l ⟩  A ≡ B ^ r / [A]
             → Γ ⊩⟨ l′ ⟩ t ≡ u ∷ B ^ r / [B]
             → Γ ⊩⟨ l ⟩  t ≡ u ∷ A ^ r / [A]
  convEqTermT₂ (ℕᵥ D D′) A≡B t≡u = t≡u
  convEqTermT₂ (Emptyᵥ D D′) A≡B t≡u = t≡u
  convEqTermT₂ {r = [ ! , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M)
               (neₜ₌ k m d d′ (neNfₜ₌ neK₂ neM₁ k≡m)) =
    let K₁≡K = PE.subst (λ x → _ ⊢ x ≡ _ ^ _)
                        (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                        (sym (≅-eq (~-to-≅ K≡M)))
    in  neₜ₌ k m (convRed:*: d K₁≡K) (convRed:*: d′ K₁≡K)
                 (neNfₜ₌ neK₂ neM₁ (~-conv k≡m K₁≡K))
  convEqTermT₂ {r = [ % , ll ]} (ne (ne K D neK K≡K) (ne K₁ D₁ neK₁ K≡K₁)) (ne₌ M D′ neM K≡M)
               (neₜ₌ d d′) =
    let K₁≡K = PE.subst (λ x → _ ⊢ x ≡ _ ^ _)
                        (whrDet* (red D′ , ne neM) (red D₁ , ne neK₁))
                        (sym (≅-eq (~-to-≅ K≡M)))
    in neₜ₌ (conv d (reduction  (red D₁) (red D) (ne neK₁) (ne neK) K₁≡K))
            (conv d′ (reduction  (red D₁) (red D) (ne neK₁) (ne neK) K₁≡K))
  convEqTermT₂ {Γ = Γ} {r = [ ! , ι ll ]} (Πᵥ (Πᵣ rF lF lG lF≤ lG≤ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                           (Πᵣ rF₁ lF₁ lG₁ lF₁≤ lG₁≤ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
               (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
               (Πₜ₌ f g d d′ funcF funcG t≡u [t] [u] [t≡u]) =
    let [A] = Πᵣ′ rF lF lG lF≤ lG≤ F G D ⊢F ⊢G A≡A [F] [G] G-ext
        [B] = Πᵣ′ rF₁ lF₁ lG₁ lF₁≤ lG₁≤ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁
        [A≡B] = Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]
        ΠF₁G₁≡ΠF′G′ = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
        ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ ! , ι ll ])
                             (PE.sym ΠF₁G₁≡ΠF′G′) (≅-eq A≡B)
    in  Πₜ₌ f g (convRed:*: d (sym ΠFG≡ΠF₁G₁)) (convRed:*: d′ (sym ΠFG≡ΠF₁G₁))
            funcF funcG (≅-conv t≡u (sym ΠFG≡ΠF₁G₁))
            (convTerm₂ [A] [B] [A≡B] [t]) (convTerm₂ [A] [B] [A≡B] [u])
            (λ {ρ} [ρ] ⊢Δ [a] →
               let F₁≡F′ , rF₁≡rF′ , lF₁≡lF′ , G₁≡G′ , lG₁≡lG′ , lΠ≡lΠ₁ = Π-PE-injectivity (whrDet* (red D₁ , Πₙ) (D′ , Πₙ))
                   [F≡F₁] = irrelevanceEqR′ (PE.cong (wk ρ) (PE.sym F₁≡F′))
                                            ([F] [ρ] ⊢Δ) ([F≡F′] [ρ] ⊢Δ)
                   [a]₁ = convTerm₁′ (PE.sym rF₁≡rF′) (PE.cong ι (PE.sym lF₁≡lF′)) ([F] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) [F≡F₁] [a]
                   [G≡G₁] = irrelevanceEqR′ (PE.cong (λ x → wk (lift ρ) x [ _ ])
                                                     (PE.sym G₁≡G′))
                                            ([G] [ρ] ⊢Δ [a])
                                            ([G≡G′] [ρ] ⊢Δ [a])
               in  convEqTerm₂′ PE.refl (PE.cong ι (PE.sym lG₁≡lG′)) ([G] [ρ] ⊢Δ [a]) ([G]₁ [ρ] ⊢Δ [a]₁)
                               [G≡G₁] ([t≡u] [ρ] ⊢Δ [a]₁))
  convEqTermT₂ {Γ = Γ} {r = [ % , ι ll ]} (Πᵥ (Πᵣ rF lF lG _ _ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                           (Πᵣ rF₁ lF₁ lG₁ _ _ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
               (Π₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
               (d , d′) =
               let ΠF₁G₁≡ΠF′G′ = whrDet* (red D₁ , Πₙ) (D′ , Πₙ)
                   ΠFG≡ΠF₁G₁ = PE.subst (λ x → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° ll ≡ x ^ [ % , ι ll ])
                                        (PE.sym ΠF₁G₁≡ΠF′G′) (≅-eq A≡B)
               in (conv d (sym ΠFG≡ΠF₁G₁)) , (conv d′ (sym ΠFG≡ΠF₁G₁))
  convEqTermT₂ {Γ = Γ} {r = [ % , ll ]} (∃ᵥ (∃ᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)
                           (∃ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁))
               (∃₌ F′ G′ D′ A≡B [F≡F′] [G≡G′])
               (d , d′) =
               let ∃F₁G₁≡∃F′G′ = whrDet* (red D₁ , ∃ₙ) (D′ , ∃ₙ)
                   ∃FG≡∃F₁G₁ = PE.subst (λ x → Γ ⊢ ∃ F ▹ G ≡ x ^ [ % , ll ])
                                        (PE.sym ∃F₁G₁≡∃F′G′) (≅-eq A≡B)
               in (conv d (sym ∃FG≡∃F₁G₁)) , (conv d′ (sym ∃FG≡∃F₁G₁))
  convEqTermT₂ (Uᵥ (Uᵣ r l l< el d) (Uᵣ r' l' l<' PE.refl d')) A≡B X =
    let U≡U   = whrDet* (A≡B , Uₙ) (red d' , Uₙ)
        r≡r , l≡l = Univ-PE-injectivity (PE.sym U≡U)
        dd = PE.subst (λ x → _ ⊢ _ :⇒*: Univ x _ ^ _) (PE.sym r≡r) (PE.subst (λ x → _ ⊢ _ :⇒*: Univ _ x ^ [ ! , next x ]) (PE.sym l≡l) d)
    in reduction-irrelevant-Univ= {l< = l<'} {el = PE.refl} {D = dd} {D' = d} r≡r (convEqTermTUniv X)
  convEqTermT₂ (emb⁰¹ X) A≡B t≡u = convEqTermT₂ X A≡B t≡u
  convEqTermT₂ (emb¹⁰ X) A≡B t≡u = convEqTermT₂ X A≡B t≡u
  convEqTermT₂ (emb¹∞ X) A≡B t≡u = convEqTermT₂ X A≡B t≡u
  convEqTermT₂ (emb∞¹ X) A≡B t≡u = convEqTermT₂ X A≡B t≡u

  -- Conversion of term equality converting from left to right.
  convEqTerm₁ : ∀ {l l′ Γ A B t u r} ([A] : Γ ⊩⟨ l ⟩ A ^ r) ([B] : Γ ⊩⟨ l′ ⟩ B ^ r)
              → Γ ⊩⟨ l ⟩  A ≡ B ^ r / [A]
              → Γ ⊩⟨ l ⟩  t ≡ u ∷ A ^ r / [A]
              → Γ ⊩⟨ l′ ⟩ t ≡ u ∷ B ^ r / [B]
  convEqTerm₁ [A] [B] A≡B t≡u = convEqTermT₁ (goodCases [A] [B] A≡B) A≡B t≡u

  -- Conversion of term equality converting from left to right. with PE
  convEqTerm₁′ : ∀ {l l′ Γ A B t u r r' ll ll'} (eq : r PE.≡ r') (eql : ll PE.≡ ll')
                   ([A] : Γ ⊩⟨ l ⟩ A ^ [ r , ll ]) ([B] : Γ ⊩⟨ l′ ⟩ B ^ [ r' , ll' ])
              → Γ ⊩⟨ l ⟩  A ≡ B ^ [ r , ll ] / [A]
              → Γ ⊩⟨ l ⟩  t ≡ u ∷ A ^ [ r , ll ] / [A]
              → Γ ⊩⟨ l′ ⟩ t ≡ u ∷ B ^ [ r' , ll' ] / [B]
  convEqTerm₁′ PE.refl PE.refl [A] [B] A≡B t≡u = convEqTerm₁ [A] [B] A≡B t≡u

  -- Conversion of term equality converting from right to left.
  convEqTerm₂ : ∀ {l l′ Γ A B t u r ll} ([A] : Γ ⊩⟨ l ⟩ A ^ [ r , ll ]) ([B] : Γ ⊩⟨ l′ ⟩ B ^ [ r , ll ])
            → Γ ⊩⟨ l ⟩  A ≡ B ^ [ r , ll ] / [A]
            → Γ ⊩⟨ l′ ⟩ t ≡ u ∷ B ^ [ r , ll ] / [B]
            → Γ ⊩⟨ l ⟩  t ≡ u ∷ A ^ [ r , ll ] / [A]
  convEqTerm₂ [A] [B] A≡B t≡u = convEqTermT₂ (goodCases [A] [B] A≡B) A≡B t≡u

  -- Conversion of term equality converting from right to left with PE
  convEqTerm₂′ : ∀ {l l′ Γ A B t u r r' ll ll'} (eq : r PE.≡ r') (eql : ll PE.≡ ll')
                   ([A] : Γ ⊩⟨ l ⟩ A ^ [ r , ll ]) ([B] : Γ ⊩⟨ l′ ⟩ B ^ [ r' , ll' ])
            → Γ ⊩⟨ l ⟩  A ≡ B ^ [ r , ll ] / [A]
            → Γ ⊩⟨ l′ ⟩ t ≡ u ∷ B ^ [ r' , ll' ] / [B]
            → Γ ⊩⟨ l ⟩  t ≡ u ∷ A ^ [ r , ll ] / [A]
  convEqTerm₂′ PE.refl PE.refl [A] [B] A≡B t≡u = convEqTerm₂ [A] [B] A≡B t≡u


module Selective.Examples.Bookstore where

open import Selective.ActorMonad
open import Selective.Libraries.Call using (UniqueTag ; call)
open import Prelude

open import Data.Nat
  using ( _≟_ ; pred ; ⌈_/2⌉ ; _≤?_ ; _∸_ ; _≤_ ; z≤n ; s≤s ; _<_ ; _≰_  )
open import Data.Nat.Properties
  using (≤-antisym ; ≰⇒>)
open import Data.Nat.Show
  using (show)
open import Data.String
  using (primStringEquality)

open import Debug

BookTitle = String
Money = ℕ

data BuyerRole : Set where
  Buyer1 Buyer2 : BuyerRole

record Book : Set where
  field
    title : BookTitle
    price : Money

-- ===========
--  GET QUOTE
-- ===========

GetQuoteReply : MessageType
GetQuoteReply = ValueType UniqueTag ∷ [ ValueType (Maybe Book) ]ˡ

GetQuoteReplyInterface : InboxShape
GetQuoteReplyInterface = [ GetQuoteReply ]ˡ

GetQuote : MessageType
GetQuote = ValueType UniqueTag ∷ ReferenceType GetQuoteReplyInterface ∷ [ ValueType BookTitle ]ˡ

-- ======================
--  PROPOSE CONTRIBUTION
-- ======================

record Contribution : Set where
  field
    book : Book
    money : Money

ContributionMessage : MessageType
ContributionMessage = [ ValueType Contribution ]ˡ

-- ===============
--  AGREE OR QUIT
-- ===============

data AgreeChoice : Set where
  AGREE QUIT : AgreeChoice

AgreeDecision : MessageType
AgreeDecision = [ ValueType AgreeChoice ]ˡ

-- ================
--  TRANSFER MONEY
-- ================

Transfer : MessageType
Transfer = ValueType BuyerRole ∷  [ ValueType Contribution ]ˡ

-- ============
--  INTERFACES
-- ============

Buyer1-to-Seller : InboxShape
Buyer1-to-Seller = GetQuote ∷ [ Transfer ]ˡ

Buyer2-to-Seller : InboxShape
Buyer2-to-Seller = AgreeDecision ∷ [ Transfer ]ˡ

Buyer1-to-Buyer2 : InboxShape
Buyer1-to-Buyer2 = [ ContributionMessage ]ˡ

Buyer2-to-Buyer1 : InboxShape
Buyer2-to-Buyer1 = [ AgreeDecision ]ˡ

SellerInterface : InboxShape
SellerInterface = GetQuote ∷ AgreeDecision ∷ [ Transfer ]ˡ

Buyer1Interface : InboxShape
Buyer1Interface = [ ReferenceType Buyer1-to-Seller ]ˡ ∷  [ ReferenceType Buyer1-to-Buyer2 ]ˡ ∷ GetQuoteReply ∷ [ AgreeDecision ]ˡ

Buyer2Interface : InboxShape
Buyer2Interface = [ ReferenceType Buyer2-to-Seller ]ˡ ∷ [ ReferenceType Buyer2-to-Buyer1 ]ˡ ∷ [ ContributionMessage ]ˡ

-- ========
--  COMMON
-- ========

book1 : BookTitle
book1 = "Crime and Punishment"

transfer-money : ∀ {i IS Seller Γ} →
                 Γ ⊢ Seller →
                 [ Transfer ]ˡ <: Seller →
                 BuyerRole →
                 Book →
                 Money →
                 ∞ActorM i IS ⊤₁ Γ (λ _ → Γ)
transfer-money p sub role book money = p ![t: translate-⊆ sub Z ] ((lift role) ∷ [ lift record { book = book ; money = money } ]ᵃ)

-- ========
--  SELLER
-- ========

same-buyer-role : BuyerRole → BuyerRole → Bool
same-buyer-role Buyer1 Buyer1 = true
same-buyer-role Buyer1 Buyer2 = false
same-buyer-role Buyer2 Buyer1 = false
same-buyer-role Buyer2 Buyer2 = true

data TransactionStatus (book : Book) (c1 c2 : Contribution) : Set where
  TooLittleMoney : (Contribution.money c1 + Contribution.money c2) < (Book.price book) → TransactionStatus book c1 c2
  Accepted : (Contribution.money c1 + Contribution.money c2) ≡ (Book.price book) → TransactionStatus book c1 c2
  TooMuchMoney : (Book.price book) < (Contribution.money c1 + Contribution.money c2) → TransactionStatus book c1 c2

transaction-status? : ∀ book c1 c2 → TransactionStatus book c1 c2
transaction-status? book c1 c2 with (Contribution.money c1 + Contribution.money c2 ≤? Book.price book) | (Book.price book ≤? Contribution.money c1 + Contribution.money c2)
transaction-status? book c1 c2 | yes p | yes q = Accepted (≤-antisym p q)
transaction-status? book c1 c2 | yes p | no ¬p = TooLittleMoney (≰⇒> ¬p)
transaction-status? book c1 c2 | no ¬p | q = TooMuchMoney (≰⇒> ¬p)

seller : ∀ {i} → ActorM i SellerInterface ⊤₁ [] (λ _ → [])
seller = begin do
    record {msg = Msg Z (tag ∷ _ ∷ title ∷ []) } ← selective-receive select-quote
      where
        record { msg = (Msg (S _) _) ; msg-ok = () }
    let maybe-book = find-book known-books title
    (Z ![t: Z ] (lift tag ∷ [ lift maybe-book ]ᵃ))
    after-book-quote maybe-book
  where
    select-quote : MessageFilter SellerInterface
    select-quote (Msg Z _) = true
    select-quote _ = false
    known-books : List Book
    known-books = [ record { title = book1 ; price = 37 } ]ˡ
    find-book : List Book → BookTitle → Maybe Book
    find-book [] title = nothing
    find-book (book ∷ books) title with (primStringEquality (Book.title book) title)
    ... | true = just book
    ... | false = find-book books title
    select-decision : MessageFilter SellerInterface
    select-decision (Msg (S Z) _) = true
    select-decision _ = false
    wait-for-decision : ∀ {i Γ} →
                        ∞ActorM i SellerInterface (Lift (lsuc lzero) AgreeChoice) Γ (λ _ → Γ)
    wait-for-decision = do
      record { msg = Msg (S Z) (ac ∷ []) } ← (selective-receive select-decision)
        where
          record { msg = (Msg Z _) ; msg-ok = () }
          record { msg = (Msg (S (S _)) _) ; msg-ok = () }
      return ac
    select-contribution-from : BuyerRole → MessageFilter SellerInterface
    select-contribution-from br (Msg (S (S Z)) (br' ∷ _)) = same-buyer-role br br'
    select-contribution-from _ _ = false
    wait-for-money-from : ∀ {i Γ} →
                          BuyerRole →
                          ∞ActorM i SellerInterface (Lift (lsuc lzero) Contribution) Γ (λ _ → Γ)
    wait-for-money-from br = do
      record { msg = Msg (S (S Z)) (_ ∷ contribution ∷ []) } ← (selective-receive (select-contribution-from br))
        where
          record { msg = (Msg Z _) ; msg-ok = () }
          record { msg = (Msg (S Z) _) ; msg-ok = () }
          record { msg = (Msg (S (S (S _))) _) ; msg-ok = () }
      return contribution
    transaction-message : Book → Contribution → Contribution → String
    transaction-message book c1 c2 with (transaction-status? book c1 c2)
    ... | Accepted _ = "Accepted purchase of " || Book.title book || " for $" || show (Book.price book)
    ... | TooLittleMoney p = "Received too little money for " || Book.title book || ". $" || show (Book.price book) || " - $" || show (Contribution.money c1) || " - $" || show (Contribution.money c2) || " = $" || show (Book.price book ∸ Contribution.money c1 ∸ Contribution.money c2)
    ... | TooMuchMoney p = "Received too much money for " || Book.title book || ". $" || show (Book.price book) || " - $" || show (Contribution.money c1) || " - $" || show (Contribution.money c2) || " = -$" || show ((Contribution.money c1 + Contribution.money c2) ∸ Book.price book)
    after-book-quote : ∀ {i} →
                       Maybe Book →
                       ∞ActorM i SellerInterface ⊤₁ [ GetQuoteReplyInterface ]ˡ (λ _ → [])
    after-book-quote (just book) = do
      lift AGREE ← wait-for-decision
        where
          lift QUIT → debug "seller sees that transaction was quit" (strengthen [])
      lift contrib1 ← wait-for-money-from Buyer1
      lift contrib2 ← wait-for-money-from Buyer2
      debug (transaction-message book contrib1 contrib2) (strengthen [])
    after-book-quote nothing = strengthen []

-- =========
--  BUYER 1
-- =========

buyer1 : ∀ {i} → ActorM i Buyer1Interface ⊤₁ [] (λ _ → [])
buyer1 = begin do
    wait-for-seller
    lift (just book) ← get-quote Z 0 book1
      where
        (lift nothing) → strengthen []
    wait-for-buyer2
    let my-contribution = ⌈ Book.price book /2⌉
    send-contribution Z book my-contribution
    lift AGREE ← wait-for-decision
      where
        lift QUIT → debug "buyer1 sees that transaction was quit" (strengthen [])
    (transfer-money (S Z) (⊆-suc ⊆-refl) Buyer1 book my-contribution)
    (strengthen [])
  where
    select-seller : MessageFilter Buyer1Interface
    select-seller (Msg Z _) = true
    select-seller (Msg (S _) _) = false
    wait-for-seller : ∀ {i Γ} → ∞ActorM i Buyer1Interface ⊤₁ Γ (λ _ → Buyer1-to-Seller ∷ Γ)
    wait-for-seller = do
      record { msg = Msg Z _ } ← (selective-receive select-seller)
        where
          record { msg = (Msg (S _) _) ; msg-ok = () }
      return _
    select-buyer2 : MessageFilter Buyer1Interface
    select-buyer2 (Msg (S Z) _) = true
    select-buyer2 _ = false
    wait-for-buyer2 : ∀ {i Γ} → ∞ActorM i Buyer1Interface ⊤₁ Γ (λ _ → Buyer1-to-Buyer2 ∷ Γ)
    wait-for-buyer2 = do
      record {msg = Msg (S Z) _ } ← selective-receive select-buyer2
        where
          record { msg = (Msg Z _) ; msg-ok = () }
          record { msg = (Msg (S (S _)) _) ; msg-ok = () }
      return _
    get-quote : ∀ {i Γ} →
               Γ ⊢ Buyer1-to-Seller →
               UniqueTag →
               BookTitle →
               ∞ActorM i Buyer1Interface (Lift (lsuc lzero) (Maybe Book)) Γ (λ _ → Γ)
    get-quote p tag title = do
      record { msg = Msg (S (S Z)) (_ ∷ book ∷ []) ; msg-ok = msg-ok } ← call p Z tag [ lift title ]ᵃ [ S (S Z) ]ᵐ Z
        where
          record { msg = (Msg Z (_ ∷ _)) ; msg-ok = () }
          record { msg = (Msg (S Z) (_ ∷ _)) ; msg-ok = () }
          record { msg = (Msg (S (S (S Z))) _) ; msg-ok = () }
          record { msg = (Msg (S (S (S (S _)))) _) ; msg-ok = () }
      return book
    send-contribution : ∀ {i Γ} →
                       Γ ⊢ Buyer1-to-Buyer2 →
                       Book →
                       Money →
                       ∞ActorM i Buyer1Interface ⊤₁ Γ (λ _ → Γ)
    send-contribution p book money = p ![t: Z ] [ lift record { book = book ; money = money } ]ᵃ
    select-decision : MessageFilter Buyer1Interface
    select-decision (Msg (S (S (S Z))) _) = true
    select-decision _ = false
    wait-for-decision : ∀ {i Γ} →
                        ∞ActorM i Buyer1Interface (Lift (lsuc lzero) AgreeChoice) Γ (λ _ → Γ)
    wait-for-decision = do
      record {msg = Msg (S (S (S Z))) (ac ∷ []) } ← (selective-receive select-decision)
        where
          record { msg = (Msg Z _) ; msg-ok = () }
          record { msg = (Msg (S Z) _) ; msg-ok = () }
          record { msg = (Msg (S (S Z)) _) ; msg-ok = () }
          record { msg = (Msg (S (S (S (S _)))) _) ; msg-ok = () }
      return ac

-- =========
--  BUYER 2
-- =========

buyer2 : ∀ {i} → ActorM i Buyer2Interface ⊤₁ [] (λ _ → [])
buyer2 = begin do
    wait-for-seller
    wait-for-buyer1
    lift contribution ← wait-for-contribution
    handle-contribution (S Z) Z contribution
    strengthen []
  where
    select-seller : MessageFilter Buyer2Interface
    select-seller (Msg Z _) = true
    select-seller (Msg (S _) _) = false
    wait-for-seller : ∀ {i Γ} → ∞ActorM i Buyer2Interface ⊤₁ Γ (λ _ → Buyer2-to-Seller ∷ Γ)
    wait-for-seller = do
      record { msg = Msg Z _ } ← (selective-receive select-seller)
        where
          record { msg = (Msg (S _) _) ; msg-ok = () }
      return _
    select-buyer1 : MessageFilter Buyer2Interface
    select-buyer1 (Msg (S Z) _) = true
    select-buyer1 _ = false
    wait-for-buyer1 : ∀ {i Γ} → ∞ActorM i Buyer2Interface ⊤₁ Γ (λ _ → Buyer2-to-Buyer1 ∷ Γ)
    wait-for-buyer1 = do
      record {msg = Msg (S Z) _ } ← selective-receive select-buyer1
        where
          record { msg = (Msg Z _) ; msg-ok = () }
          record { msg = (Msg (S (S _)) _) ; msg-ok = () }
      return _
    select-contribution : MessageFilter Buyer2Interface
    select-contribution (Msg (S (S Z)) _) = true
    select-contribution _ = false
    wait-for-contribution : ∀ {i Γ} → ∞ActorM i Buyer2Interface (Lift (lsuc lzero) Contribution) Γ (λ _ → Γ)
    wait-for-contribution = do
      record { msg = Msg (S (S Z)) (cc ∷ []) } ← (selective-receive select-contribution)
        where
          record { msg = (Msg Z _) ; msg-ok = () }
          record { msg = (Msg (S Z) _) ; msg-ok = () }
          record { msg = (Msg (S (S (S _))) _) ; msg-ok = () }
      return cc
    contribution-is-fair : Money → Money → Bool
    contribution-is-fair price money = ⌊ price ∸ money ≤? money ⌋
    handle-contribution : ∀ {i Γ} →
                          Γ ⊢ Buyer2-to-Seller →
                          Γ ⊢ Buyer2-to-Buyer1 →
                          Contribution →
                          ∞ActorM i Buyer2Interface ⊤₁ Γ (λ _ → Γ)
    handle-contribution seller buyer1 record { book = book ; money = money } with (contribution-is-fair (Book.price book) money)
    ... | true = do
      buyer1 ![t: Z ] [ lift AGREE ]ᵃ
      seller ![t: Z ] [ lift AGREE ]ᵃ
      transfer-money seller (⊆-suc ⊆-refl) Buyer2 book ((Book.price book) ∸ money)
    ... | false = do
      buyer1 ![t: Z ] [ lift QUIT ]ᵃ
      seller ![t: Z ] [ lift QUIT ]ᵃ

-- ============
--  SUPERVISOR
-- ============

bookstore-supervisor : ∀ {i} → ∞ActorM i [] ⊤₁ [] (λ _ → [])
bookstore-supervisor = do
  spawn seller
  spawn buyer1
  spawn buyer2
  Z ![t: Z ]  [ [ (S (S Z)) ]>: ( S Z ∷ [ S (S Z) ]ᵐ)]ᵃ
  Z ![t: S Z ] [ [ S Z ]>: [ S (S (S Z)) ]ᵐ ]ᵃ
  (S Z) ![t: Z ] [ [ S (S Z) ]>: (Z ∷ [ S (S Z) ]ᵐ) ]ᵃ
  (S Z) ![t: S Z ] [ [ Z ]>: [ S (S Z) ]ᵐ ]ᵃ
  (strengthen [])


open import Agda.Primitive.Cubical

data BadData : IUniv where


module examplesPaperJFP.NativeIOSafe where

open import Data.Maybe.Base using (Maybe; nothing; just) public
open import Data.String.Base using (String) public

record Unit : Set where
  constructor unit

{-# COMPILE GHC Unit = () #-}

postulate
  NativeIO     : Set → Set
  nativeReturn : {A : Set} → A → NativeIO A
  _native>>=_  : {A B : Set} → NativeIO A → (A → NativeIO B) → NativeIO B

{-# BUILTIN IO NativeIO #-}
{-# COMPILE GHC NativeIO = IO #-}   -- IO.FF-I.AgdaIO
{-# COMPILE GHC _native>>=_ = (\_ _ -> (>>=) :: IO a -> (a -> IO b) -> IO b) #-}
{-# COMPILE GHC nativeReturn = (\_ -> return :: a -> IO a) #-}

postulate
  nativeGetLine   : NativeIO (Maybe String)
  nativePutStrLn  : String → NativeIO Unit

{-# FOREIGN GHC import Data.Text #-}
{-# FOREIGN GHC import System.IO.Error #-}

{-# COMPILE GHC nativePutStrLn = (\ s -> putStrLn (Data.Text.unpack s)) #-}
{-# COMPILE GHC nativeGetLine = (fmap (Just . Data.Text.pack) getLine `System.IO.Error.catchIOError` \ err -> if System.IO.Error.isEOFError err then return Nothing else ioError err) #-}


------------------------------------------------------------------------
-- The Agda standard library
--
-- de Bruijn-aware generic traversal of reflected terms.
------------------------------------------------------------------------

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

open import Category.Applicative using (RawApplicative)
open import Category.Monad using (RawMonad)

module Leftovers.Everywhere {F : Set → Set} (MF : RawMonad F) where

open import Data.Nat     using (ℕ; zero; suc; _+_)
open import Data.List    using (List; []; _∷_; _++_; reverse; length)
open import Data.Product using (_×_; _,_)
open import Data.String  using (String)
open import Function     using (_∘_)
open import Reflection

open RawMonad MF

------------------------------------------------------------------------
-- Context representation

-- Track both number of variables and actual context, to avoid having to
-- compute the length of the context everytime it's needed.
record Cxt : Set where
  constructor _,,_
  pattern
  field
    len     : ℕ
    context : List (String × Arg Term)

private
  _∷cxt_ : String × Arg Term → Cxt → Cxt
  e ∷cxt (n ,, Γ) = (suc n ,, (e ∷ Γ))

  _++cxt_ : List (String × Arg Term) → Cxt → Cxt
  es ++cxt (n ,, Γ) = ((length es + n) ,, (es ++ Γ))

------------------------------------------------------------------------
-- Actions

Action : Set → Set
Action A = Cxt → A → F A
-- A traversal gets to operate on variables, metas, and names.
record Actions : Set where
  field
    onVar  : Action ℕ
    onMeta : Action Meta
    onCon  : Action Name
    onDef  : Action Name

-- Default action: do nothing.
defaultActions : Actions
defaultActions .Actions.onVar  _ = pure
defaultActions .Actions.onMeta _ = pure
defaultActions .Actions.onCon  _ = pure
defaultActions .Actions.onDef  _ = pure

------------------------------------------------------------------------
-- Traversal functions
private
 module Params (actions : Actions) (everyAction : Action Term) where

  open Actions actions

  everywhereTerm    : Action Term
  everywhereTerm'    : Action Term
  everywhereSort    : Action Sort
  everywherePattern : Action Pattern
  everywhereArgs    : Action (List (Arg Term))
  everywhereArg     : Action (Arg Term)
  everywherePats    : Action (List (Arg Pattern))
  everywhereAbs     : Arg Term → Action (Abs Term)
  everywhereClauses : Action Clauses
  everywhereClause  : Action Clause
  everywhereTel     : Action (List (String × Arg Term))

  everywhereTerm Γ t = everyAction Γ =<< everywhereTerm' Γ t

  everywhereTerm' Γ (var x args)      = var       <$> onVar Γ x ⊛ everywhereArgs Γ args
  everywhereTerm' Γ (con c args)      = con       <$> onCon Γ c ⊛ everywhereArgs Γ args
  everywhereTerm' Γ (def f args)      = def       <$> onDef Γ f ⊛ everywhereArgs Γ args
  everywhereTerm' Γ (pat-lam cs args) = pat-lam   <$> everywhereClauses Γ cs ⊛ everywhereArgs Γ args
  everywhereTerm' Γ (pi a b)          = pi        <$> everywhereArg Γ a ⊛ everywhereAbs a Γ b
  everywhereTerm' Γ (agda-sort s)     = agda-sort <$> everywhereSort Γ s
  everywhereTerm' Γ (meta x args)     = meta      <$> onMeta Γ x ⊛ everywhereArgs Γ args
  everywhereTerm' Γ t@(lit _)         = pure t
  everywhereTerm' Γ t@unknown         = pure t
  everywhereTerm' Γ (lam v t)         = lam v     <$> everywhereAbs (arg (arg-info v m) unknown) Γ t
    where
    m = defaultModality

  everywhereArg Γ (arg i t) = arg i <$> everywhereTerm Γ t
  everywhereArgs Γ []       = pure []
  everywhereArgs Γ (a ∷ as) = _∷_ <$> everywhereArg Γ a ⊛ everywhereArgs Γ as

  everywhereAbs ty Γ (abs x t) = abs x <$> everywhereTerm ((x , ty) ∷cxt Γ) t

  everywhereClauses Γ []       = pure []
  everywhereClauses Γ (c ∷ cs) = _∷_ <$> everywhereClause Γ c ⊛ everywhereClauses Γ cs

  everywhereClause Γ (Clause.clause tel ps t) =
      Clause.clause <$> everywhereTel Γ tel
                     ⊛  everywherePats Γ′ ps
                     ⊛ everywhereTerm Γ′ t
    where Γ′ = reverse tel ++cxt Γ
  everywhereClause Γ (Clause.absurd-clause tel ps) =
      Clause.absurd-clause <$> everywhereTel Γ tel
                            ⊛  everywherePats Γ′ ps
    where Γ′ = reverse tel ++cxt Γ

  everywhereTel Γ [] = pure []
  everywhereTel Γ ((x , ty) ∷ tel) =
    _∷_ ∘ (x ,_) <$> everywhereArg Γ ty ⊛ everywhereTel ((x , ty) ∷cxt Γ) tel

  everywhereSort Γ (Sort.set t)       = Sort.set <$> everywhereTerm Γ t
  everywhereSort Γ t@(Sort.lit _)     = pure t
  everywhereSort Γ (Sort.prop t)      = Sort.prop <$> everywhereTerm Γ t
  everywhereSort Γ t@(Sort.propLit _) = pure t
  everywhereSort Γ t@(Sort.inf _)     = pure t
  everywhereSort Γ t@Sort.unknown     = pure t

  everywherePattern Γ (Pattern.con c ps) = Pattern.con <$> onCon Γ c ⊛ everywherePats Γ ps
  everywherePattern Γ (Pattern.dot t)    = Pattern.dot <$> everywhereTerm Γ t
  everywherePattern Γ (Pattern.var x)    = Pattern.var <$> onVar Γ x
  everywherePattern Γ p@(Pattern.lit _)  = pure p
  everywherePattern Γ p@(Pattern.proj _) = pure p
  everywherePattern Γ (Pattern.absurd x) = Pattern.absurd <$> onVar Γ x

  everywherePats Γ [] = pure []
  everywherePats Γ (arg i p ∷ ps) = _∷_ ∘ arg i <$> everywherePattern Γ p ⊛ everywherePats Γ ps

everywhere : (actions : Actions) → (everyAction : Action Term) → Term → F Term
everywhere actions every = Params.everywhereTerm actions every (0 ,, [])


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

module C where

open import Data.Empty
open import Data.Unit
open import Data.Sum
open import Data.Product
open import Relation.Binary.PropositionalEquality

open import Singleton

infixr 70 _×ᵤ_
infixr 60 _+ᵤₗ_
infixr 60 _+ᵤᵣ_
infixr 50 _⊚_

------------------------------------------------------------------------------
-- Pi

data 𝕌 : Set
⟦_⟧ : 𝕌 → Σ[ A ∈ Set ] A
data _⟷_ : 𝕌 → 𝕌 → Set

data 𝕌 where
  𝟙       : 𝕌
  _+ᵤₗ_    : 𝕌 → 𝕌 → 𝕌
  _+ᵤᵣ_    : 𝕌 → 𝕌 → 𝕌
  _×ᵤ_    : 𝕌 → 𝕌 → 𝕌
  Singᵤ : 𝕌 → 𝕌
  Recipᵤ : 𝕌 → 𝕌

⟦ 𝟙 ⟧ = ⊤ , tt
⟦ T₁ ×ᵤ T₂ ⟧ = zip _×_ _,_ ⟦ T₁ ⟧ ⟦ T₂ ⟧
⟦ T₁ +ᵤₗ T₂ ⟧ = zip _⊎_ (λ x _ → inj₁ x) ⟦ T₁ ⟧ ⟦ T₂ ⟧
⟦ T₁ +ᵤᵣ T₂ ⟧ = zip _⊎_ (λ _ y → inj₂ y) ⟦ T₁ ⟧ ⟦ T₂ ⟧
⟦ Singᵤ T ⟧ = < uncurry Singleton , (λ y → proj₂ y , refl) > ⟦ T ⟧
⟦ Recipᵤ T ⟧ = < uncurry Recip , (λ _ _ → tt) > ⟦ T ⟧

data _⟷_ where
  swap₊₁   : {t₁ t₂ : 𝕌} → t₁ +ᵤₗ t₂ ⟷ t₂ +ᵤᵣ t₁
  swap₊₂   : {t₁ t₂ : 𝕌} → t₁ +ᵤᵣ t₂ ⟷ t₂ +ᵤₗ t₁
  assocl₊₁ : {t₁ t₂ t₃ : 𝕌} → t₁ +ᵤₗ (t₂ +ᵤₗ t₃) ⟷ (t₁ +ᵤₗ t₂) +ᵤₗ t₃
  assocl₊₂ : {t₁ t₂ t₃ : 𝕌} → t₁ +ᵤₗ (t₂ +ᵤᵣ t₃) ⟷ (t₁ +ᵤₗ t₂) +ᵤₗ t₃
  assocl₊₃ : {t₁ t₂ t₃ : 𝕌} → t₁ +ᵤᵣ (t₂ +ᵤₗ t₃) ⟷ (t₁ +ᵤᵣ t₂) +ᵤₗ t₃
  assocl₊₄ : {t₁ t₂ t₃ : 𝕌} → t₁ +ᵤᵣ (t₂ +ᵤᵣ t₃) ⟷ (t₁ +ᵤₗ t₂) +ᵤᵣ t₃
  assocl₊₅ : {t₁ t₂ t₃ : 𝕌} → t₁ +ᵤᵣ (t₂ +ᵤᵣ t₃) ⟷ (t₁ +ᵤᵣ t₂) +ᵤᵣ t₃
  assocr₊₁ : {t₁ t₂ t₃ : 𝕌} → (t₁ +ᵤₗ t₂) +ᵤₗ t₃ ⟷ t₁ +ᵤₗ (t₂ +ᵤᵣ t₃)
  assocr₊₂ : {t₁ t₂ t₃ : 𝕌} → (t₁ +ᵤₗ t₂) +ᵤₗ t₃ ⟷ t₁ +ᵤₗ (t₂ +ᵤₗ t₃)
  assocr₊₃ : {t₁ t₂ t₃ : 𝕌} → (t₁ +ᵤᵣ t₂) +ᵤₗ t₃ ⟷ t₁ +ᵤᵣ (t₂ +ᵤₗ t₃)
  assocr₊₄ : {t₁ t₂ t₃ : 𝕌} → (t₁ +ᵤₗ t₂) +ᵤᵣ t₃ ⟷ t₁ +ᵤᵣ (t₂ +ᵤᵣ t₃)
  assocr₊₅ : {t₁ t₂ t₃ : 𝕌} → (t₁ +ᵤᵣ t₂) +ᵤᵣ t₃ ⟷ t₁ +ᵤᵣ (t₂ +ᵤᵣ t₃)
  unite⋆l : {t : 𝕌} → 𝟙 ×ᵤ t ⟷ t
  uniti⋆l : {t : 𝕌} → t ⟷ 𝟙 ×ᵤ t
  unite⋆r : {t : 𝕌} → t ×ᵤ 𝟙 ⟷ t
  uniti⋆r : {t : 𝕌} → t ⟷ t ×ᵤ 𝟙
  swap⋆   : {t₁ t₂ : 𝕌} → t₁ ×ᵤ t₂ ⟷ t₂ ×ᵤ t₁
  assocl⋆ : {t₁ t₂ t₃ : 𝕌} → t₁ ×ᵤ (t₂ ×ᵤ t₃) ⟷ (t₁ ×ᵤ t₂) ×ᵤ t₃
  assocr⋆ : {t₁ t₂ t₃ : 𝕌} → (t₁ ×ᵤ t₂) ×ᵤ t₃ ⟷ t₁ ×ᵤ (t₂ ×ᵤ t₃)
  dist₁    : {t₁ t₂ t₃ : 𝕌} → (t₁ +ᵤₗ t₂) ×ᵤ t₃ ⟷ (t₁ ×ᵤ t₃) +ᵤₗ (t₂ ×ᵤ t₃)
  dist₂    : {t₁ t₂ t₃ : 𝕌} → (t₁ +ᵤᵣ t₂) ×ᵤ t₃ ⟷ (t₁ ×ᵤ t₃) +ᵤᵣ (t₂ ×ᵤ t₃)
  factor₁  : {t₁ t₂ t₃ : 𝕌} → (t₁ ×ᵤ t₃) +ᵤₗ (t₂ ×ᵤ t₃) ⟷ (t₁ +ᵤₗ t₂) ×ᵤ t₃
  factor₂  : {t₁ t₂ t₃ : 𝕌} → (t₁ ×ᵤ t₃) +ᵤᵣ (t₂ ×ᵤ t₃) ⟷ (t₁ +ᵤᵣ t₂) ×ᵤ t₃
  distl₁   : {t₁ t₂ t₃ : 𝕌} → t₁ ×ᵤ (t₂ +ᵤₗ t₃) ⟷ (t₁ ×ᵤ t₂) +ᵤₗ (t₁ ×ᵤ t₃)
  distl₂   : {t₁ t₂ t₃ : 𝕌} → t₁ ×ᵤ (t₂ +ᵤᵣ t₃) ⟷ (t₁ ×ᵤ t₂) +ᵤᵣ (t₁ ×ᵤ t₃)
  factorl₁ : {t₁ t₂ t₃ : 𝕌 } → (t₁ ×ᵤ t₂) +ᵤₗ (t₁ ×ᵤ t₃) ⟷ t₁ ×ᵤ (t₂ +ᵤₗ t₃)
  factorl₂ : {t₁ t₂ t₃ : 𝕌 } → (t₁ ×ᵤ t₂) +ᵤᵣ (t₁ ×ᵤ t₃) ⟷ t₁ ×ᵤ (t₂ +ᵤᵣ t₃)
  id⟷     : {t : 𝕌} → t ⟷ t
  _⊚_     : {t₁ t₂ t₃ : 𝕌} → (t₁ ⟷ t₂) → (t₂ ⟷ t₃) → (t₁ ⟷ t₃)
  _⊕₁_     : {t₁ t₂ t₃ t₄ : 𝕌} → (t₁ ⟷ t₃) → (t₂ ⟷ t₄) → (t₁ +ᵤₗ t₂ ⟷ t₃ +ᵤₗ t₄)
  _⊕₂_     : {t₁ t₂ t₃ t₄ : 𝕌} → (t₁ ⟷ t₃) → (t₂ ⟷ t₄) → (t₁ +ᵤᵣ t₂ ⟷ t₃ +ᵤᵣ t₄)
  _⊗_     : {t₁ t₂ t₃ t₄ : 𝕌} → (t₁ ⟷ t₃) → (t₂ ⟷ t₄) → (t₁ ×ᵤ t₂ ⟷ t₃ ×ᵤ t₄)
  -- monad
  return : (T : 𝕌) → T ⟷ Singᵤ T
  join : (T : 𝕌) → Singᵤ (Singᵤ T) ⟷ Singᵤ T
  unjoin : (T : 𝕌) → Singᵤ T ⟷ Singᵤ (Singᵤ T)
  tensorl : (T₁ T₂ : 𝕌) → (Singᵤ T₁ ×ᵤ T₂) ⟷ Singᵤ (T₁ ×ᵤ T₂)
  tensorr : (T₁ T₂ : 𝕌) → (T₁ ×ᵤ Singᵤ T₂) ⟷ Singᵤ (T₁ ×ᵤ T₂)
  tensor : (T₁ T₂ : 𝕌) → (Singᵤ T₁ ×ᵤ Singᵤ T₂) ⟷ Singᵤ (T₁ ×ᵤ T₂)
  untensor : (T₁ T₂ : 𝕌) → Singᵤ (T₁ ×ᵤ T₂) ⟷ (Singᵤ T₁ ×ᵤ Singᵤ T₂)
  plusl : (T₁ T₂ : 𝕌) → (Singᵤ T₁ +ᵤₗ T₂) ⟷ Singᵤ (T₁ +ᵤₗ T₂)
  plusr : (T₁ T₂ : 𝕌) → (T₁ +ᵤᵣ Singᵤ T₂) ⟷ Singᵤ (T₁ +ᵤᵣ T₂)
  -- comonad
  extract : (T : 𝕌) → Singᵤ T ⟷ T
  cojoin : (T : 𝕌) → Singᵤ T ⟷ Singᵤ (Singᵤ T)
  counjoin : (T : 𝕌) → Singᵤ (Singᵤ T) ⟷ Singᵤ T
  cotensorl : (T₁ T₂ : 𝕌) → Singᵤ (T₁ ×ᵤ T₂) ⟷ (Singᵤ T₁ ×ᵤ T₂)
  cotensorr : (T₁ T₂ : 𝕌) → Singᵤ (T₁ ×ᵤ T₂) ⟷ (T₁ ×ᵤ Singᵤ T₂)
  coplusl : (T₁ T₂ : 𝕌) → Singᵤ (T₁ +ᵤₗ T₂) ⟷ (Singᵤ T₁ +ᵤₗ T₂)
  coplusr : (T₁ T₂ : 𝕌) → Singᵤ (T₁ +ᵤᵣ T₂) ⟷ (T₁ +ᵤᵣ Singᵤ T₂)
  -- both?
  Singᵤ : (T₁ T₂ : 𝕌) → (T₁ ⟷ T₂) → (Singᵤ T₁ ⟷ Singᵤ T₂)
  -- eta/epsilon
  η : (T : 𝕌) → 𝟙 ⟷ (Singᵤ T ×ᵤ Recipᵤ T)
  ε : (T : 𝕌) → (Singᵤ T ×ᵤ Recipᵤ T) ⟷ 𝟙

!_ : {t₁ t₂ : 𝕌} → t₁ ⟷ t₂ → t₂ ⟷ t₁
! swap₊₁ = swap₊₂
! swap₊₂ = swap₊₁
! assocl₊₁ = assocr₊₂
! assocl₊₂ = assocr₊₁
! assocl₊₃ = assocr₊₃
! assocl₊₄ = assocr₊₄
! assocl₊₅ = assocr₊₅
! assocr₊₁ = assocl₊₂
! assocr₊₂ = assocl₊₁
! assocr₊₃ = assocl₊₃
! assocr₊₄ = assocl₊₄
! assocr₊₅ = assocl₊₅
! unite⋆l = uniti⋆l
! uniti⋆l = unite⋆l
! unite⋆r = uniti⋆r
! uniti⋆r = unite⋆r
! swap⋆ = swap⋆
! assocl⋆ = assocr⋆
! assocr⋆ = assocl⋆
! dist₁ = factor₁
! dist₂ = factor₂
! factor₁ = dist₁
! factor₂ = dist₂
! distl₁ = factorl₁
! distl₂ = factorl₂
! factorl₁ = distl₁
! factorl₂ = distl₂
! id⟷ = id⟷
! (c ⊚ c₁) = (! c₁) ⊚ (! c)
! (c ⊕₁ c₁) = (! c) ⊕₁ (! c₁)
! (c ⊕₂ c₁) = (! c) ⊕₂ (! c₁)
! (c ⊗ c₁) = (! c) ⊗ (! c₁)
! return T = extract T
! join T = return (Singᵤ T)
! unjoin T = join T
! tensorl T₁ T₂ = cotensorl T₁ T₂
! tensorr T₁ T₂ = cotensorr T₁ T₂
! tensor T₁ T₂ = untensor T₁ T₂
! untensor T₁ T₂ = tensor T₁ T₂
! plusl T₁ T₂ = coplusl T₁ T₂
! plusr T₁ T₂ = coplusr T₁ T₂
! extract T = return T
! cojoin T = join T
! counjoin T = return (Singᵤ T)
! cotensorl T₁ T₂ = tensorl T₁ T₂
! cotensorr T₁ T₂ = tensorr T₁ T₂
! coplusl T₁ T₂ = plusl T₁ T₂
! coplusr T₁ T₂ = plusr T₁ T₂
! Singᵤ T₁ T₂ c = Singᵤ T₂ T₁ (! c)
! η T = ε T
! ε T = η T


module ExplicitImplicitConversion where
open import ExpressionChanging
open import Data.Nat
open import Data.List
open import ParseTree
open import ScopeState
open import Data.Vec using (Vec ; _∷_)
open import Data.Fin
open import Data.List.NonEmpty
open import AgdaHelperFunctions
open import Data.Bool
open import ParseTreeOperations

-- is given types before conversion
-- namedArgument for type, never just implicit!!!!!!
conversionIns : {n : ℕ} -> Vec Expr n -> Fin n -> (List Expr -> List Expr)
conversionIns Vec.[] () l
conversionIns _ _ [] = []
conversionIns (namedArgument _ {false} ∷ x₁) zero (implicit y ∷ list) = y ∷ list
-- expecting implicit and getting explicit, i.e. argument to be moved
-- isn't specified.
conversionIns (namedArgument _ {false} ∷ x₁) zero (y ∷ list) =  newUnderscore ∷ y ∷ list
conversionIns (x ∷ x₁) zero (x₂ ∷ list) = implicit x₂ ∷ list
conversionIns (namedArgument _ {false} ∷ x₁) (suc n) (implicit x₂ ∷ list) =
  implicit x₂ ∷ conversionIns x₁ n list
conversionIns (namedArgument _ {false} ∷ x₁) (suc n) (x₂ ∷ list) =
  let result = conversionIns x₁ n (x₂ ∷ list)
  in if headImplicit? result then (implicit newUnderscore) ∷ result
        else result
    where headImplicit? : List Expr -> Bool
          headImplicit? (implicit x ∷ l) = true
          headImplicit? _ = false
conversionIns (x ∷ x₁) (suc n) (x₂ ∷ list) = x₂ ∷ conversionIns x₁ n list

convertInExpr : TypeSignature -> ℕ -> ScopeState (List⁺ Expr -> List⁺ Expr)
convertInExpr t n = makeInstruction t n conversionIns

convertInSignature : {n : ℕ} -> Vec Expr (suc n)  -> Fin n -> ScopeState (Vec Expr (suc n))
convertInSignature (namedArgument arg {isExplicit} {c}{c2} ∷ l) zero =
  return $ namedArgument arg {not isExplicit}{c}{c2} ∷ l
convertInSignature (implicit x ∷ l) zero = return $ x ∷ l
convertInSignature (x ∷ l) zero = do
    newName <- getUniqueIdentifier
    return $ namedArgument (typeSignature newName x) {false} {[]} {[]} ∷ l
convertInSignature (x ∷ v) (suc f) = do
    rest <- convertInSignature v f
    return $ x ∷ rest

convert : List ParseTree -> (funcID : ℕ) -> (whichArgument : ℕ) -> ScopeState (List ParseTree)
convert code funcId whichArgument = doForArgument code funcId whichArgument convertInSignature convertInExpr


open import Agda.Builtin.Nat

bar : Nat → Nat
bar n = let _!_ : Nat → Nat → Nat
            x ! y = 2 * x ! y  -- should give scope error in RHS
        in n ! n


------------------------------------------------------------------------
-- The Agda standard library
--
-- Literals used in the reflection machinery
------------------------------------------------------------------------

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

module Reflection.Literal where

import Data.Char as Char
import Data.Float as Float
import Data.Nat as ℕ
open import Data.String as String using (String)
import Data.Word as Word
import Reflection.Meta as Meta
import Reflection.Name as Name
open import Relation.Nullary
import Relation.Nullary.Decidable as Dec
open import Relation.Binary
open import Relation.Binary.PropositionalEquality

------------------------------------------------------------------------
-- Re-exporting the builtin type and constructors

open import Agda.Builtin.Reflection public
  using ( Literal )
open Literal public

------------------------------------------------------------------------
-- Decidable equality

meta-injective : ∀ {x y} → meta x ≡ meta y → x ≡ y
meta-injective refl = refl

nat-injective : ∀ {x y} → nat x ≡ nat y → x ≡ y
nat-injective refl = refl

word64-injective : ∀ {x y} → word64 x ≡ word64 y → x ≡ y
word64-injective refl = refl

float-injective : ∀ {x y} → float x ≡ float y → x ≡ y
float-injective refl = refl

char-injective : ∀ {x y} → char x ≡ char y → x ≡ y
char-injective refl = refl

string-injective : ∀ {x y} → string x ≡ string y → x ≡ y
string-injective refl = refl

name-injective : ∀ {x y} → name x ≡ name y → x ≡ y
name-injective refl = refl

infix 4 _≟_
_≟_ : DecidableEquality Literal
nat x ≟ nat x₁ = Dec.map′ (cong nat) nat-injective (x ℕ.≟ x₁)
nat x ≟ word64 x₁ = no (λ ())
nat x ≟ float x₁ = no (λ ())
nat x ≟ char x₁ = no (λ ())
nat x ≟ string x₁ = no (λ ())
nat x ≟ name x₁ = no (λ ())
nat x ≟ meta x₁ = no (λ ())
word64 x ≟ word64 x₁ = Dec.map′ (cong word64) word64-injective (x Word.≟ x₁)
word64 x ≟ nat x₁ = no (λ ())
word64 x ≟ float x₁ = no (λ ())
word64 x ≟ char x₁ = no (λ ())
word64 x ≟ string x₁ = no (λ ())
word64 x ≟ name x₁ = no (λ ())
word64 x ≟ meta x₁ = no (λ ())
float x ≟ nat x₁ = no (λ ())
float x ≟ word64 x₁ = no (λ ())
float x ≟ float x₁ = Dec.map′ (cong float) float-injective (x Float.≟ x₁)
float x ≟ char x₁ = no (λ ())
float x ≟ string x₁ = no (λ ())
float x ≟ name x₁ = no (λ ())
float x ≟ meta x₁ = no (λ ())
char x ≟ nat x₁ = no (λ ())
char x ≟ word64 x₁ = no (λ ())
char x ≟ float x₁ = no (λ ())
char x ≟ char x₁ = Dec.map′ (cong char) char-injective (x Char.≟ x₁)
char x ≟ string x₁ = no (λ ())
char x ≟ name x₁ = no (λ ())
char x ≟ meta x₁ = no (λ ())
string x ≟ nat x₁ = no (λ ())
string x ≟ word64 x₁ = no (λ ())
string x ≟ float x₁ = no (λ ())
string x ≟ char x₁ = no (λ ())
string x ≟ string x₁ = Dec.map′ (cong string) string-injective (x String.≟ x₁)
string x ≟ name x₁ = no (λ ())
string x ≟ meta x₁ = no (λ ())
name x ≟ nat x₁ = no (λ ())
name x ≟ word64 x₁ = no (λ ())
name x ≟ float x₁ = no (λ ())
name x ≟ char x₁ = no (λ ())
name x ≟ string x₁ = no (λ ())
name x ≟ name x₁ = Dec.map′ (cong name) name-injective (x Name.≟ x₁)
name x ≟ meta x₁ = no (λ ())
meta x ≟ nat x₁ = no (λ ())
meta x ≟ word64 x₁ = no (λ ())
meta x ≟ float x₁ = no (λ ())
meta x ≟ char x₁ = no (λ ())
meta x ≟ string x₁ = no (λ ())
meta x ≟ name x₁ = no (λ ())
meta x ≟ meta x₁ = Dec.map′ (cong meta) meta-injective (x Meta.≟ x₁)


{-# OPTIONS --without-K #-}
module well-typed-syntax-helpers where
open import common
open import well-typed-syntax

infixl 3 _‘'’ₐ_
infixr 1 _‘→'’_
infixl 3 _‘t’_
infixl 3 _‘t’₁_
infixl 3 _‘t’₂_
infixr 2 _‘∘’_

WS∀ : ∀ {Γ T T' A B} {a : Term {Γ = Γ} T} → Term {Γ = Γ ▻ T'} (W ((A ‘→’ B) ‘’ a)) → Term {Γ ▻ T'} (W ((A ‘’ a) ‘→’ (B ‘’₁ a)))
WS∀ = weakenTyp-substTyp-tProd

_‘→'’_ : ∀ {Γ} → Typ Γ → Typ Γ → Typ Γ
_‘→'’_ {Γ = Γ} A B = _‘→’_ {Γ = Γ} A (W {Γ = Γ} {A = A} B)

_‘'’ₐ_ : ∀ {Γ A B} → Term {Γ} (A ‘→'’ B) → Term A → Term B
_‘'’ₐ_ {Γ} {A} {B} f x = SW (_‘’ₐ_ {Γ} {A} {W B} f x)

_‘t’_ : ∀ {Γ A} {B : Typ (Γ ▻ A)} → (b : Term {Γ = Γ ▻ A} B) → (a : Term {Γ} A) → Term {Γ} (B ‘’ a)
b ‘t’ a = ‘λ∙’ b ‘’ₐ a

substTyp-tProd : ∀ {Γ T A B} {a : Term {Γ} T} →
                         Term {Γ} ((A ‘→’ B) ‘’ a)
                         → Term {Γ} (_‘→’_ {Γ = Γ} (A ‘’ a) (B ‘’₁ a))
substTyp-tProd {Γ} {T} {A} {B} {a} x = SW ((WS∀ (w x)) ‘t’ a)

S∀ = substTyp-tProd

‘λ'∙’ : ∀ {Γ A B} → Term {Γ ▻ A} (W B) -> Term (A ‘→'’ B)
‘λ'∙’ f = ‘λ∙’ f

SW1V : ∀ {Γ A T} → Term {Γ ▻ A} (W1 T ‘’ ‘VAR₀’) → Term {Γ ▻ A} T
SW1V = substTyp-weakenTyp1-VAR₀

S₁∀ : ∀ {Γ T T' A B} {a : Term {Γ} T} → Term {Γ ▻ T' ‘’ a} ((A ‘→’ B) ‘’₁ a) → Term {Γ ▻ T' ‘’ a} ((A ‘’₁ a) ‘→’ (B ‘’₂ a))
S₁∀ = substTyp1-tProd

un‘λ∙’ : ∀ {Γ A B} → Term (A ‘→’ B) → Term {Γ ▻ A} B
un‘λ∙’ f = SW1V (weakenTyp-tProd (w f) ‘’ₐ ‘VAR₀’)

weakenProd : ∀ {Γ A B C} →
                          Term {Γ} (A ‘→’ B)
                          → Term {Γ = Γ ▻ C} (W A ‘→’ W1 B)
weakenProd {Γ} {A} {B} {C} x = weakenTyp-tProd (w x)
w∀ = weakenProd

w1 : ∀ {Γ A B C} → Term {Γ = Γ ▻ B} C → Term {Γ = Γ ▻ A ▻ W {Γ = Γ} {A = A} B} (W1 {Γ = Γ} {A = A} {B = B} C)
w1 x = un‘λ∙’ (weakenTyp-tProd (w (‘λ∙’ x)))

_‘t’₁_ : ∀ {Γ A B C} → (c : Term {Γ = Γ ▻ A ▻ B} C) → (a : Term {Γ} A) → Term {Γ = Γ ▻ B ‘’ a} (C ‘’₁ a)
f ‘t’₁ x = un‘λ∙’ (S∀ (‘λ∙’ (‘λ∙’ f) ‘’ₐ x))
_‘t’₂_ : ∀ {Γ A B C D} → (c : Term {Γ = Γ ▻ A ▻ B ▻ C} D) → (a : Term {Γ} A) → Term {Γ = Γ ▻ B ‘’ a ▻ C ‘’₁ a} (D ‘’₂ a)
f ‘t’₂ x = un‘λ∙’ (S₁∀ (un‘λ∙’ (S∀ (‘λ∙’ (‘λ∙’ (‘λ∙’ f)) ‘’ₐ x))))

S₁₀W' : ∀ {Γ C T A} {a : Term {Γ} C} {b : Term {Γ} (T ‘’ a)} → Term {Γ} (A ‘’ a) → Term {Γ} (W A ‘’₁ a ‘’ b)
S₁₀W' = substTyp1-substTyp-weakenTyp-inv

S₁₀W : ∀ {Γ C T A} {a : Term {Γ} C} {b : Term {Γ} (T ‘’ a)} → Term {Γ} (W A ‘’₁ a ‘’ b) → Term {Γ} (A ‘’ a)
S₁₀W = substTyp1-substTyp-weakenTyp

substTyp1-substTyp-weakenTyp-weakenTyp : ∀ {Γ T A} {B : Typ (Γ ▻ A)}
    → {a : Term {Γ} A}
    → {b : Term {Γ} (B ‘’ a)}
    → Term {Γ} (W (W T) ‘’₁ a ‘’ b)
    → Term {Γ} T
substTyp1-substTyp-weakenTyp-weakenTyp x = SW (S₁₀W x)

S₁₀WW = substTyp1-substTyp-weakenTyp-weakenTyp

S₂₁₀W : ∀ {Γ A B C T} {a : Term {Γ} A} {b : Term {Γ} (B ‘’ a)} {c : Term {Γ} (C ‘’₁ a ‘’ b)}
      → Term {Γ} (W T ‘’₂ a ‘’₁ b ‘’ c)
      → Term {Γ} (T ‘’₁ a ‘’ b)
S₂₁₀W = substTyp2-substTyp1-substTyp-weakenTyp

substTyp2-substTyp1-substTyp-weakenTyp-weakenTyp : ∀ {Γ A B C T}
         {a : Term {Γ} A}
         {b : Term {Γ} (B ‘’ a)}
         {c : Term {Γ} (C ‘’₁ a ‘’ b)} →
    Term {Γ} (W (W T) ‘’₂ a ‘’₁ b ‘’ c)
    → Term {Γ} (T ‘’ a)
substTyp2-substTyp1-substTyp-weakenTyp-weakenTyp x = S₁₀W (S₂₁₀W x)

S₂₁₀WW = substTyp2-substTyp1-substTyp-weakenTyp-weakenTyp

W1W : ∀ {Γ A B C} → Term {Γ ▻ A ▻ W B} (W1 (W C)) → Term {Γ ▻ A ▻ W B} (W (W C))
W1W = weakenTyp1-weakenTyp

W1W1W : ∀ {Γ A B C T} → Term {Γ ▻ A ▻ B ▻ W (W C)} (W1 (W1 (W T))) → Term {Γ ▻ A ▻ B ▻ W (W C)} (W1 (W (W T)))
W1W1W = weakenTyp1-weakenTyp1-weakenTyp

weakenTyp-tProd-nd : ∀ {Γ A B C} →
                          Term {Γ = Γ ▻ C} (W (A ‘→'’ B))
                          → Term {Γ = Γ ▻ C} (W A ‘→'’ W B)
weakenTyp-tProd-nd x = ‘λ'∙’ (W1W (SW1V (weakenTyp-tProd (w (weakenTyp-tProd x)) ‘’ₐ ‘VAR₀’)))

weakenProd-nd : ∀ {Γ A B C} →
                             Term (A ‘→'’ B)
                             → Term {Γ = Γ ▻ C} (W A ‘→'’ W B)
weakenProd-nd {Γ} {A} {B} {C} x = weakenTyp-tProd-nd (w x)

weakenTyp-tProd-nd-tProd-nd : ∀ {Γ A B C D} →
    Term {Γ = Γ ▻ D} (W (A ‘→'’ B ‘→'’ C))
    → Term {Γ = Γ ▻ D} (W A ‘→'’ W B ‘→'’ W C)
weakenTyp-tProd-nd-tProd-nd x = ‘λ∙’ (weakenTyp-tProd-inv (‘λ∙’ (W1W1W (SW1V (w∀ (weakenTyp-tProd (weakenTyp-weakenTyp-tProd (w→ (weakenTyp-tProd-nd x) ‘'’ₐ ‘VAR₀’))) ‘’ₐ ‘VAR₀’)))))

weakenProd-nd-Prod-nd : ∀ {Γ A B C D} →
    Term (A ‘→'’ B ‘→'’ C)
    → Term {Γ = Γ ▻ D} (W A ‘→'’ W B ‘→'’ W C)
weakenProd-nd-Prod-nd {Γ} {A} {B} {C} {D} x = weakenTyp-tProd-nd-tProd-nd (w x)
w→→ = weakenProd-nd-Prod-nd

S₁W1 : ∀ {Γ A B C} {a : Term {Γ} A} → Term {Γ ▻ W B ‘’ a} (W1 C ‘’₁ a) → Term {Γ ▻ B} C
S₁W1 = substTyp1-weakenTyp1

W1S₁W' : ∀ {Γ A T'' T' T} {a : Term {Γ} A}
      → Term {Γ ▻ T'' ▻ W (T' ‘’ a)} (W1 (W (T ‘’ a)))
      → Term {Γ ▻ T'' ▻ W (T' ‘’ a)} (W1 (W T ‘’₁ a))
W1S₁W' = weakenTyp1-substTyp-weakenTyp1-inv

substTyp-weakenTyp1-inv : ∀ {Γ A T' T}
         {a : Term {Γ} A} →
    Term {Γ = (Γ ▻ T' ‘’ a)} (W (T ‘’ a))
    → Term {Γ = (Γ ▻ T' ‘’ a)} (W T ‘’₁ a)
substTyp-weakenTyp1-inv {a = a} x = S₁W1 (W1S₁W' (w1 x) ‘t’₁ a)

S₁W' = substTyp-weakenTyp1-inv

_‘∘’_ : ∀ {Γ A B C}
    → Term {Γ} (A ‘→'’ B)
    → Term {Γ} (B ‘→'’ C)
    → Term {Γ} (A ‘→'’ C)
g ‘∘’ f = ‘λ∙’ (w→ f ‘'’ₐ (w→ g ‘'’ₐ ‘VAR₀’))

WS₀₀W1 : ∀ {Γ T' B A} {b : Term {Γ} B} {a : Term {Γ ▻ B} (W A)} {T : Typ (Γ ▻ A)}
      → Term {Γ ▻ T'} (W (W1 T ‘’ a ‘’ b))
      → Term {Γ ▻ T'} (W (T ‘’ (SW (a ‘t’ b))))
WS₀₀W1 = weakenTyp-substTyp-substTyp-weakenTyp1

WS₀₀W1' : ∀ {Γ T' B A} {b : Term {Γ} B} {a : Term {Γ ▻ B} (W A)} {T : Typ (Γ ▻ A)}
      → Term {Γ ▻ T'} (W (T ‘’ (SW (a ‘t’ b))))
      → Term {Γ ▻ T'} (W (W1 T ‘’ a ‘’ b))
WS₀₀W1' = weakenTyp-substTyp-substTyp-weakenTyp1-inv

substTyp-substTyp-weakenTyp1-inv-arr : ∀ {Γ B A}
         {b : Term {Γ} B}
         {a : Term {Γ ▻ B} (W A)}
         {T : Typ (Γ ▻ A)}
         {X} →
    Term {Γ} (T ‘’ (SW (a ‘t’ b)) ‘→'’ X)
    → Term {Γ} (W1 T ‘’ a ‘’ b ‘→'’ X)
substTyp-substTyp-weakenTyp1-inv-arr x = ‘λ∙’ (w→ x ‘'’ₐ WS₀₀W1 ‘VAR₀’)

S₀₀W1'→ = substTyp-substTyp-weakenTyp1-inv-arr

substTyp-substTyp-weakenTyp1-arr-inv : ∀ {Γ B A}
         {b : Term {Γ} B}
         {a : Term {Γ ▻ B} (W A)}
         {T : Typ (Γ ▻ A)}
         {X} →
    Term {Γ} (X ‘→'’ T ‘’ (SW (a ‘t’ b)))
    → Term {Γ} (X ‘→'’ W1 T ‘’ a ‘’ b)
substTyp-substTyp-weakenTyp1-arr-inv x = ‘λ∙’ (WS₀₀W1' (un‘λ∙’ x))

S₀₀W1'← = substTyp-substTyp-weakenTyp1-arr-inv

substTyp-substTyp-weakenTyp1 : ∀ {Γ B A}
         {b : Term {Γ} B}
         {a : Term {Γ ▻ B} (W A)}
         {T : Typ (Γ ▻ A)} →
    Term {Γ} (W1 T ‘’ a ‘’ b)
    → Term {Γ} (T ‘’ (SW (a ‘t’ b)))
substTyp-substTyp-weakenTyp1 x = (SW (WS₀₀W1 (w x) ‘t’ x))
S₀₀W1 = substTyp-substTyp-weakenTyp1

SW1W : ∀ {Γ T} {A : Typ Γ} {B : Typ Γ}
      → {a : Term {Γ = Γ ▻ T} (W {Γ = Γ} {A = T} B)}
      → Term {Γ = Γ ▻ T} (W1 (W A) ‘’ a)
      → Term {Γ = Γ ▻ T} (W A)
SW1W = substTyp-weakenTyp1-weakenTyp

S₂₀₀W1WW : ∀ {Γ A} {T : Typ (Γ ▻ A)} {T' C B} {a : Term {Γ} A} {b : Term {Γ = (Γ ▻ C ‘’ a)} (B ‘’₁ a)}
         {c : Term {Γ = (Γ ▻ T')} (W (C ‘’ a))}
         → Term {Γ = (Γ ▻ T')} (W1 (W (W T) ‘’₂ a ‘’ b) ‘’ c)
         → Term {Γ = (Γ ▻ T')} (W (T ‘’ a))
S₂₀₀W1WW = substTyp2-substTyp-substTyp-weakenTyp1-weakenTyp-weakenTyp

S₁₀W2W : ∀ {Γ T' A B T} {a : Term {Γ ▻ T'} (W A)} {b : Term {Γ ▻ T'} (W1 B ‘’ a)}
      → Term {Γ ▻ T'} (W2 (W T) ‘’₁ a ‘’ b)
      → Term {Γ ▻ T'} (W1 T ‘’ a)
S₁₀W2W = substTyp1-substTyp-weakenTyp2-weakenTyp


open import Relation.Binary using (IsDecEquivalence)
open import Agda.Builtin.Equality

-- module UnifyMguFTerminationHunt (FunctionName : Set) ⦃ isDecEquivalenceA : IsDecEquivalence (_≡_ {A = FunctionName}) ⦄ where

module UnifyMguFTerminationHunt where

postulate
  FunctionName : Set
  instance isDecEquivalenceA : IsDecEquivalence (_≡_ {A = FunctionName})

open IsDecEquivalence isDecEquivalenceA using () renaming (_≟_ to _≟F_)

open import UnifyTermF FunctionName

open import Data.Product using (∃; _,_)
open import Data.Maybe using (Maybe; just; nothing)
open import Category.Monad using (RawMonad)
import Level
open RawMonad (Data.Maybe.monad {Level.zero})
open import Relation.Nullary using (Dec; yes; no)

open import Data.Fin using (Fin)
open import Data.Nat using (suc)
postulate
  _◃′_ : ∀ {m n} -> (f : m ~> n) -> Term m -> Term n
  _for'_ : ∀ {n} (t' : Term n) (x : Fin (suc n)) -> Fin (suc n) -> Term n

amterm : ∀ {m} (s t : Term m) (acc : ∃ (AList m)) -> Maybe (∃ (AList m))
amterm leaf leaf acc = just acc
amterm leaf (function _ _) acc = nothing
amterm leaf (s' fork t') acc = nothing
amterm (s' fork t') leaf acc = nothing
amterm (s' fork t') (function _ _) acc = nothing
amterm (s1 fork s2) (t1 fork t2) acc = amterm s2 t2 =<< amterm s1 t1 acc {- Data.Maybe.maybe (⋆amgu.amgu ⋆amguTerm' s2 t2) nothing (⋆amgu.amgu ⋆amguTerm' s1 t1 acc) -}
amterm (function fn₁ ts₁) leaf acc = nothing
amterm (function fn₁ {n₁} ts₁) (function fn₂ {n₂} ts₂) acc = nothing
amterm (function fn₁ ts₁) (_ fork _) acc = nothing
amterm (i x) (i y) (m , anil) = nothing
amterm (i x) t     (m , anil) = nothing
amterm t     (i x) (m , anil) = nothing
amterm s     t  (n , σ asnoc r / z) =
         (λ σ -> σ ∃asnoc r / z) <$>
           -- amgu ((r for z) ◃ s) ((r for z) ◃ t) (n , σ)
           amterm ((r for' z) ◃′ s) ((r for' z) ◃′ t) (n , σ)

-- instance ⋆amguTerm' : ⋆amgu Term
-- ⋆amguTerm' .⋆amgu.amgu leaf leaf acc = just acc
-- ⋆amguTerm' .⋆amgu.amgu leaf (function _ _) acc = nothing
-- ⋆amguTerm' .⋆amgu.amgu leaf (s' fork t') acc = nothing
-- ⋆amguTerm' .⋆amgu.amgu (s' fork t') leaf acc = nothing
-- ⋆amguTerm' .⋆amgu.amgu (s' fork t') (function _ _) acc = nothing
-- ⋆amguTerm' .⋆amgu.amgu (s1 fork s2) (t1 fork t2) acc = amgu s2 t2 =<< amgu s1 t1 acc {- Data.Maybe.maybe (⋆amgu.amgu ⋆amguTerm' s2 t2) nothing (⋆amgu.amgu ⋆amguTerm' s1 t1 acc) -}
-- ⋆amguTerm' .⋆amgu.amgu (function fn₁ ts₁) leaf acc = nothing
-- ⋆amguTerm' .⋆amgu.amgu (function fn₁ {n₁} ts₁) (function fn₂ {n₂} ts₂) acc = nothing
-- ⋆amguTerm' .⋆amgu.amgu (function fn₁ ts₁) (_ fork _) acc = nothing
-- ⋆amguTerm' .⋆amgu.amgu (i x) (i y) (m , anil) = nothing
-- ⋆amguTerm' .⋆amgu.amgu (i x) t     (m , anil) = nothing
-- ⋆amguTerm' .⋆amgu.amgu t     (i x) (m , anil) = nothing
-- ⋆amguTerm' .⋆amgu.amgu s     t  (n , σ asnoc r / z) =
--          (λ σ -> σ ∃asnoc r / z) <$>
--            -- amgu ((r for z) ◃ s) ((r for z) ◃ t) (n , σ)
--            amgu ((r for z) ◃′ s) ((r for z) ◃′ t) (n , σ)

-- -- instance ⋆amguTerm' : ⋆amgu Term
-- -- ⋆amgu.amgu ⋆amguTerm' leaf leaf acc = just acc
-- -- ⋆amgu.amgu ⋆amguTerm' leaf (function _ _) acc = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' leaf (s' fork t') acc = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' (s' fork t') leaf acc = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' (s' fork t') (function _ _) acc = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' (s1 fork s2) (t1 fork t2) acc = {!amgu s2 t2 =<< amgu s1 t1 acc!} {- Data.Maybe.maybe (⋆amgu.amgu ⋆amguTerm' s2 t2) nothing (⋆amgu.amgu ⋆amguTerm' s1 t1 acc) -}
-- -- ⋆amgu.amgu ⋆amguTerm' (function fn₁ ts₁) leaf acc = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' (function fn₁ {n₁} ts₁) (function fn₂ {n₂} ts₂) acc = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' (function fn₁ ts₁) (_ fork _) acc = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' (i x) (i y) (m , anil) = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' (i x) t     (m , anil) = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' t     (i x) (m , anil) = nothing
-- -- ⋆amgu.amgu ⋆amguTerm' s     t  (n , σ asnoc r / z) =
-- --          (λ σ -> σ ∃asnoc r / z) <$>
-- --            -- amgu ((r for z) ◃ s) ((r for z) ◃ t) (n , σ)
-- --            amgu ((r for z) ◃′ s) ((r for z) ◃′ t) (n , σ)

-- -- -- mutual

-- -- --   instance ⋆amguTerm : ⋆amgu Term
-- -- --   ⋆amgu.amgu ⋆amguTerm leaf leaf acc = just acc
-- -- --   ⋆amgu.amgu ⋆amguTerm leaf (function _ _) acc = nothing
-- -- --   ⋆amgu.amgu ⋆amguTerm leaf (s' fork t') acc = nothing
-- -- --   ⋆amgu.amgu ⋆amguTerm (s' fork t') leaf acc = nothing
-- -- --   ⋆amgu.amgu ⋆amguTerm (s' fork t') (function _ _) acc = nothing
-- -- --   ⋆amgu.amgu ⋆amguTerm (s1 fork s2) (t1 fork t2) acc =
-- -- --                     amgu s2 t2 =<< amgu s1 t1 acc
-- -- --   ⋆amgu.amgu ⋆amguTerm (function fn₁ ts₁) leaf acc = nothing
-- -- --   ⋆amgu.amgu ⋆amguTerm (function fn₁ {n₁} ts₁) (function fn₂ {n₂} ts₂) acc
-- -- --    with fn₁ ≟F fn₂
-- -- --   … | no _ = nothing
-- -- --   … | yes _ with n₁ ≟ n₂
-- -- --   … | no _ = nothing
-- -- --   … | yes refl = amgu ts₁ ts₂ acc
-- -- --   ⋆amgu.amgu ⋆amguTerm (function fn₁ ts₁) (_ fork _) acc = nothing
-- -- --   ⋆amgu.amgu ⋆amguTerm (i x) (i y) (m , anil) = just (flexFlex x y)
-- -- --   ⋆amgu.amgu ⋆amguTerm (i x) t     (m , anil) = flexRigid x t
-- -- --   ⋆amgu.amgu ⋆amguTerm t     (i x) (m , anil) = flexRigid x t
-- -- --   ⋆amgu.amgu ⋆amguTerm s     t  (n , σ asnoc r / z) =
-- -- --            (λ σ -> σ ∃asnoc r / z) <$>
-- -- --              amgu ((r for z) ◃ s) ((r for z) ◃ t) (n , σ)

-- -- --   instance ⋆amguVecTerm : ∀ {N} → ⋆amgu (flip Vec N ∘ Term)
-- -- --   ⋆amgu.amgu ⋆amguVecTerm [] [] acc = just acc
-- -- --   ⋆amgu.amgu ⋆amguVecTerm (t₁ ∷ t₁s) (t₂ ∷ t₂s) acc = amgu t₁s t₂s =<< amgu t₁ t₂ acc

-- -- -- mgu : ∀ {m} -> (s t : Term m) -> Maybe (∃ (AList m))
-- -- -- mgu {m} s t = amgu s t (m , anil)


module cedille-syntax where
open import lib
open import ctxt
open import syntax-util
open import general-util
open import is-free
open import cedille-types

-- App, AppTp
infixl 10 _`_ _-_ _·_
-- Pattern and constructor
pattern _`_ t t' = App t NotErased t'
pattern _-_ t t' = App t Erased t'
pattern _·_ t T = AppTp t T

-- Beta
infix 9 β<_> β[_] β<_>[_] `β<_> `β[_] `β<_>[_]
pattern β = Beta _ NoTerm NoTerm
pattern β<_> t = Beta _ (SomeTerm t _) NoTerm
pattern β[_] t = Beta _ NoTerm (SomeTerm t _)
pattern β<_>[_] t t' = Beta _ (SomeTerm t _) (SomeTerm t' _)
`β = Beta pi-gen NoTerm NoTerm
`β<_> = λ t → Beta pi-gen (SomeTerm t pi-gen) NoTerm
`β[_] = λ t → Beta pi-gen NoTerm (SomeTerm t pi-gen)
`β<_>[_] = λ t t' → Beta pi-gen (SomeTerm t pi-gen) (SomeTerm t' pi-gen)

-- Chi
infixr 8 χ-_ χ_-_ `χ-_ `χ_-_
pattern χ-_ t = Chi _ NoType t
pattern χ_-_ T t = Chi _ (SomeType T) t
`χ-_ = Chi pi-gen NoType
`χ_-_ = λ T t → Chi pi-gen (SomeType T) t

-- Delta
infixr 8 δ-_ δ_-_ `δ-_ `δ_-_
pattern δ-_ t = Delta _ NoType t
pattern δ_-_ T t = Delta _ (SomeType T) t
`δ-_ = Delta pi-gen NoType
`δ_-_ = λ T t → Delta pi-gen (SomeType T) t

-- Epsilon
infixr 8 ε_ εl_ εr_ ε-_ εl-_ εr-_ `ε_ `εl_ `εr_ `ε-_ `εl-_ `εr-_
pattern ε_ t = Epsilon _ Both ff t
pattern εl_ t = Epsilon _ Left ff t
pattern εr_ t = Epsilon _ Right ff t
pattern ε-_ t = Epsilon _ Both tt t
pattern εl-_ t = Epsilon _ Left tt t
pattern εr-_ t = Epsilon _ Right tt t
`ε_ = Epsilon pi-gen Both ff
`εl_ = Epsilon pi-gen Left ff
`εr_ = Epsilon pi-gen Right ff
`ε-_ = Epsilon pi-gen Both tt
`εl-_ = Epsilon pi-gen Left tt
`εr-_ = Epsilon pi-gen Right tt

-- Hole
pattern ● = Hole _
`● = Hole pi-gen

-- IotaPair
pattern [_`,_] t₁ t₂ = IotaPair _ t₁ t₂ NoGuide _
pattern [_`,_*_₊_] t₁ t₂ x T = IotaPair _ t₁ t₂ (Guide _ x T) _ -- "₊" = "\_+"
`[_`,_] = λ t₁ t₂ → IotaPair pi-gen t₁ t₂ NoGuide pi-gen
`[_`,_*_₊_] = λ t₁ t₂ x T → IotaPair pi-gen t₁ t₂ (Guide pi-gen x T) pi-gen

-- IotaProj
infixl 5 _₊1 _₊2 _₊#_ _`₊1 _`₊2 _`₊#_
pattern _₊1 t = IotaProj t "1" _
pattern _₊2 t = IotaProj t "2" _
pattern _₊#_ t n = IotaProj t n _
_`₊1 = λ t → IotaProj t "1" pi-gen
_`₊2 = λ t → IotaProj t "2" pi-gen
_`₊#_ = λ t n → IotaProj t n pi-gen

-- Lam
infixr 4 λ`_₊_ λ`_:ₜ_₊_ λ`_:ₖ_₊_ Λ_₊_ Λ_:ₜ_₊_ Λ_:ₖ_₊_ `λ_₊_ `λ_:ₜ_₊_ `λ_:ₖ_₊_ `Λ_₊_ `Λ_:ₜ_₊_ `Λ_:ₖ_₊_
pattern λ`_₊_ x t = Lam _ NotErased _ x NoClass t
pattern λ`_:ₜ_₊_ x T t = Lam _ NotErased _ x (SomeClass (Tkt T)) t
pattern λ`_:ₖ_₊_ x k t = Lam _ NotErased _ x (SomeClass (Tkk k)) t
pattern Λ_₊_ x t = Lam _ Erased _ x NoClass t
pattern Λ_:ₜ_₊_ x T t = Lam _ Erased _ x (SomeClass (Tkt T)) t
pattern Λ_:ₖ_₊_ x k t = Lam _ Erased _ x (SomeClass (Tkk k)) t
`λ_₊_ = λ x t → Lam pi-gen NotErased pi-gen x NoClass t
`λ_:ₜ_₊_ = λ x T t → Lam pi-gen NotErased pi-gen x (SomeClass (Tkt T)) t
`λ_:ₖ_₊_ = λ x k t → Lam pi-gen NotErased pi-gen x (SomeClass (Tkk k)) t
`Λ_₊_ = λ x t → Lam pi-gen Erased pi-gen x NoClass t
`Λ_:ₜ_₊_ = λ x T t → Lam pi-gen Erased pi-gen x (SomeClass (Tkt T)) t
`Λ_:ₖ_₊_ = λ x k t → Lam pi-gen Erased pi-gen x (SomeClass (Tkk k)) t

-- Let
infixr 8 [_`=_]-_ [_:ₜ_`=_]-_ [_:ₖ_`=_]-_ -[_`=_]-_ -[_:ₜ_`=_]-_ -[_:ₖ_`=_]-_ `[_`=_]-_ `[_:ₜ_`=_]-_ `[_:ₖ_`=_]-_ `-[_`=_]-_ `-[_:ₜ_`=_]-_ `-[_:ₖ_`=_]-_
pattern [_`=_]-_ x t t' = Let _ NotErased (DefTerm _ x NoType t _) t'
pattern [_:ₜ_`=_]-_ x T t t' = Let _ NotErased (DefTerm _ x (SomeType T) t _) t'
pattern [_:ₖ_`=_]-_ x k T t' = Let _ NotErased (DefType _ x k T _) t'
pattern -[_`=_]-_ x t t' = Let _ Erased (DefTerm _ x NoType t _) t'
pattern -[_:ₜ_`=_]-_ x T t t' = Let _ Erased (DefTerm _ x (SomeType T) t _) t'
pattern -[_:ₖ_`=_]-_ x k T t' = Let _ Erased (DefType _ x k T _) t'
`[_`=_]-_ = λ x t t' → Let pi-gen NotErased (DefTerm pi-gen x NoType t) t'
`[_:ₜ_`=_]-_ = λ x T t t' → Let pi-gen NotErased (DefTerm pi-gen x (SomeType T) t) t'
`[_:ₖ_`=_]-_ = λ x k T t' → Let pi-gen NotErased (DefType pi-gen x k T) t'
`-[_`=_]-_ = λ x t t' → Let pi-gen Erased (DefTerm pi-gen x NoType t) t'
`-[_:ₜ_`=_]-_ = λ x T t t' → Let pi-gen Erased (DefTerm pi-gen x (SomeType T) t) t'
`-[_:ₖ_`=_]-_ = λ x k T t' → Let pi-gen Erased (DefType pi-gen x k T) t'

-- Open
infixr 8 open`_-_ `open_-_ close`_-_ `close_-_
pattern open`_-_ x t = Open _ OpacTrans _ x t
pattern close`_-_ x t = Open _ OpacOpaque _ x t
`open_-_ = Open pi-gen OpacTrans pi-gen
`close_-_ = Open pi-gen OpacOpaque pi-gen

--Parens
infix 4 ⦅_⦆ `⦅_⦆
pattern ⦅_⦆ t = Parens _ t _
`⦅_⦆ = λ t → Parens pi-gen t pi-gen

-- Phi
infix 8 φ_-_[_] `φ_-_[_]
pattern φ_-_[_] eq t₁ t₂ = Phi _ eq t₁ t₂ _
`φ_-_[_] = λ eq t₁ t₂ → Phi pi-gen eq t₁ t₂ pi-gen

-- Rho
infixr 8 ρ_-_ ρ<_>_-_ ρ_*_₊_-_ ρ<_>_*_₊_-_ ρ+_-_ ρ+<_>_-_ ρ+_*_₊_-_ ρ+<_>_*_₊_-_ `ρ_-_ `ρ<_>_-_ `ρ_*_₊_-_ `ρ<_>_*_₊_-_ `ρ+_-_ `ρ+<_>_-_ `ρ+_*_₊_-_ `ρ+<_>_*_₊_-_
pattern ρ_-_ t t' = Rho _ ff NoNums t NoGuide t'
pattern ρ<_>_-_ ns t t' = Rho _ ff (SomeNums ns) t NoGuide t'
pattern ρ_*_₊_-_ t x T t' = Rho _ ff NoNums t (Guide _ x T) t'
pattern ρ<_>_*_₊_-_ ns t x T t' = Rho _ ff (SomeNums ns) t (Guide _ x T) t'
pattern ρ+_-_ t t' = Rho _ tt NoNums t NoGuide t'
pattern ρ+<_>_-_ ns t t' = Rho _ tt (SomeNums ns) t NoGuide t'
pattern ρ+_*_₊_-_ t x T t' = Rho _ tt NoNums t (Guide _ x T) t'
pattern ρ+<_>_*_₊_-_ ns t x T t' = Rho _ tt (SomeNums ns) t (Guide _ x T) t'
`ρ_-_ = λ t t' → Rho pi-gen ff NoNums t NoGuide t'
`ρ<_>_-_ = λ ns t t' → Rho pi-gen ff (SomeNums ns) t NoGuide t'
`ρ_*_₊_-_ = λ t x T t' → Rho pi-gen ff NoNums t (Guide pi-gen x T) t'
`ρ<_>_*_₊_-_ = λ ns t x T t' → Rho pi-gen ff (SomeNums ns) t (Guide pi-gen x T) t'
`ρ+_-_ = λ t t' → Rho pi-gen tt NoNums t NoGuide t'
`ρ+<_>_-_ = λ ns t t' → Rho pi-gen tt (SomeNums ns) t NoGuide t'
`ρ+_*_₊_-_ = λ t x T t' → Rho pi-gen tt NoNums t (Guide pi-gen x T) t'
`ρ+<_>_*_₊_-_ = λ ns t x T t' → Rho pi-gen tt (SomeNums ns) t (Guide pi-gen x T) t'

-- Sigma
infixr 9 ς_ `ς_
pattern ς_ t = Sigma _ t
`ς_ = Sigma pi-gen

-- Theta
infix 9 θ_`_ θ+_`_ θ<_>_`_ `θ_`_ `θ+_`_ `θ<_>_`_
pattern θ_`_ t ts = Theta _ Abstract t ts
pattern θ+_`_ t ts = Theta _ AbstractEq t ts
pattern θ<_>_`_ vs t ts = Theta _ (AbstractVars vs) t ts
`θ_`_ = λ t ts → Theta pi-gen Abstract t ts
`θ+_`_ = λ t ts → Theta pi-gen AbstractEq t ts
`θ<_>_`_ = λ vs t ts → Theta pi-gen (AbstractVars vs) t ts

-- Mu
infix 9 μ_₊_[_] μ_₊_*_[_] `μ_₊_[_] `μ_₊_*_[_]
pattern μ_₊_[_] x t ms = Mu _ _ x t NoType _ ms _
pattern μ_₊_*_[_] x t T ms = Mu _ _ x t (SomeType T) _ ms _
`μ_₊_[_] = λ x t ms → Mu pi-gen pi-gen x t NoType pi-gen ms pi-gen
`μ_₊_*_[_] = λ x t T ms → Mu pi-gen pi-gen x t (SomeType T) pi-gen ms pi-gen

-- Mu'
infix 9 μ'_[_] μ'_*_[_] μ'<_>_[_] μ'<_>_*_[_] `μ'_[_] `μ'_*_[_] `μ'_[_] `μ'_*_[_]
pattern μ'_[_] t ms = Mu' _ NoTerm t NoType _ ms _
pattern μ'_*_[_] t T ms = Mu' _ NoTerm t (SomeType T) _ ms _
pattern μ'<_>_[_] t t' ms = Mu' _ (SomeTerm t) t' NoType _ ms _
pattern μ'<_>_*_[_] t t' T ms = Mu' _ (SomeTerm t) t' (SomeType T) _ ms _
`μ'_[_] = λ t ms → Mu' pi-gen NoTerm t NoType pi-gen ms pi-gen
`μ'_*_[_] = λ t T ms → Mu' pi-gen NoTerm t (SomeType T) pi-gen ms pi-gen
`μ'<_>_[_] = λ t t' ms → Mu' pi-gen (SomeTerm t pi-gen) t' NoType pi-gen ms pi-gen
`μ'<_>_*_[_] = λ t t' T ms → Mu' pi-gen (SomeTerm t pi-gen) t' (SomeType T) pi-gen ms pi-gen

-- Var
infixr 11 vₓ_ `vₓ_
pattern vₓ_ x = Var _ x
`vₓ_ = Var pi-gen

-- Abs
infixr 5 ∀`_:ₜ_₊_ ∀`_:ₖ_₊_ Π_:ₜ_₊_ Π_:ₖ_₊_ `∀_:ₜ_₊_ `∀_:ₖ_₊_ `Π_:ₜ_₊_ `Π_:ₖ_₊_
pattern ∀`_:ₜ_₊_ x T T' = Abs _ All _ x (Tkt T) T'
pattern ∀`_:ₖ_₊_ x k T = Abs _ All _ x (Tkk k) T
pattern Π_:ₜ_₊_ x T T' = Abs _ Pi _ x (Tkt T) T'
pattern Π_:ₖ_₊_ x k T = Abs _ Pi _ x (Tkk k) T
`∀_:ₜ_₊_ = λ x T T' → Abs pi-gen All pi-gen x (Tkt T) T'
`∀_:ₖ_₊_ = λ x k T → Abs pi-gen All pi-gen x (Tkk k) T
`Π_:ₜ_₊_ = λ x T T' → Abs pi-gen Pi pi-gen x (Tkt T) T'
`Π_:ₖ_₊_ = λ x k T → Abs pi-gen Pi pi-gen x (Tkk k) T

-- Iota
infix 4 ι_:ₜ_₊_ `ι_:ₜ_₊_
pattern ι_:ₜ_₊_ x T T' = Iota _ _ x T T'
`ι_:ₜ_₊_ = Iota pi-gen pi-gen

-- Lft
infix 4 ↑_₊_:ₗ_ `↑_₊_:ₗ_
pattern ↑_₊_:ₗ_ X t lT = Lft _ _ X t lT
`↑_₊_:ₗ_ = Lft pi-gen pi-gen

-- NoSpans
infix 4 [^_^] `[^_^]
pattern [^_^] T = NoSpans T _
`[^_^] = λ T → NoSpans T pi-gen

-- TpLet
infixr 5 [_`=_]ₜ-_ [_:ₜ_`=_]ₜ-_ [_:ₖ_`=_]ₜ-_ `[_`=_]ₜ-_ `[_:ₜ_`=_]ₜ-_ `[_:ₖ_`=_]ₜ-_
pattern [_`=_]ₜ-_ x t t' = TpLet _ (DefTerm _ x NoType t _) t'
pattern [_:ₜ_`=_]ₜ-_ x T t t' = TpLet _ (DefTerm _ x (SomeType T) t _) t'
pattern [_:ₖ_`=_]ₜ-_ x k T t' = TpLet _ (DefType _ x k T _) t'
`[_`=_]ₜ-_ = λ x t t' → TpLet pi-gen (DefTerm pi-gen x NoType t) t'
`[_:ₜ_`=_]ₜ-_ = λ x T t t' → TpLet pi-gen (DefTerm pi-gen x (SomeType T) t) t'
`[_:ₖ_`=_]ₜ-_ = λ x k T t' → TpLet pi-gen (DefType pi-gen x k T) t'

-- TpApp, TpAppt
infixl 10 _·ₜ_ _`ₜ_
-- Pattern and constructor
pattern _·ₜ_ T T' = TpApp T T'
pattern _`ₜ_ T t = TpAppt T t

-- TpArrow
infixr 5 _➔_ _➾_  -- "➔" = "\r" (↕ 5, ↔ 1), "➾" = "\r" (↕ 7, ↔ 8)
pattern _➔_ T T' = TpArrow T NotErased T'
pattern _➾_ T T' = TpArrow T Erased T'

-- TpEq
infix 4 [_≃_] `[_≃_]
pattern [_≃_] t₁ t₂ = TpEq _ t₁ t₂ _
`[_≃_] = λ t₁ t₂ → TpEq pi-gen t₁ t₂ pi-gen

-- TpHole
pattern ●ₜ = TpHole _
`●ₜ = TpHole pi-gen

-- TpLambda
infixr 4 λₜ_:ₜ_₊_ λₜ_:ₖ_₊_ `λₜ_:ₜ_₊_ `λₜ_:ₖ_₊_
pattern λₜ_:ₜ_₊_ x T T' = TpLambda _ _ x (Tkt T) T'
pattern λₜ_:ₖ_₊_ x k T = TpLambda _ _ x (Tkk k) T
`λₜ_:ₜ_₊_ = λ x T T' → TpLambda pi-gen pi-gen x (Tkt T) T'
`λₜ_:ₖ_₊_ = λ x k T → TpLambda pi-gen pi-gen x (Tkk k) T

-- TpParens
infix 4 ⦅_⦆ₜ `⦅_⦆ₜ
pattern ⦅_⦆ₜ T = TpParens _ T _
`⦅_⦆ₜ = λ T → TpParens pi-gen T pi-gen

-- TpVar
infix 11 Vₓ_ `Vₓ_
pattern Vₓ_ x = TpVar _ x
`Vₓ_ = TpVar pi-gen

-- KndArrow : kind → kind → kind

-- KndParens : posinfo → kind → posinfo → kind
infix 4 ⦅_⦆ₖ `⦅_⦆ₖ
pattern ⦅_⦆ₖ k = KndParens _ k _
`⦅_⦆ₖ = λ k → KndParens pi-gen k pi-gen

-- KndPi : posinfo → posinfo → bvar → tk → kind → kind

-- KndTpArrow : type → kind → kind

-- KndVar
infix 11 κ_`_ `κ_`_
pattern κ_`_ x as = KndVar _ x as
`κ_`_ = KndVar pi-gen

-- Star
pattern ★ = Star _
`★ = Star pi-gen