module Tactic.Nat.Subtract.Reflect where

open import Prelude
import Agda.Builtin.Nat as Builtin
open import Builtin.Reflection
open import Control.Monad.State
open import Control.Monad.Transformer
open import Tactic.Reflection
open import Tactic.Reflection.Quote

open import Tactic.Nat.Reflect
open import Tactic.Nat.Subtract.Exp

⟨suc⟩s : SubExp →  SubExp
⟨suc⟩s (lit n) = lit (suc n)
⟨suc⟩s (lit n ⟨+⟩ e) = lit (suc n) ⟨+⟩ e
⟨suc⟩s e = lit 1 ⟨+⟩ e

freshS : Term → R SubExp
freshS t =
  get >>= uncurry′ λ i Γ →
  var i <$ put (suc i , (t , i) ∷ Γ)

pattern _`-_ x y = def (quote Builtin._-_) (vArg x ∷ vArg y ∷ [])

private
  forceInstance : Name → Term → R ⊤
  forceInstance i v = lift $ unify v (def₀ i)
  forceNumber   = forceInstance (quote NumberNat)
  forceSemiring = forceInstance (quote SemiringNat)
  forceSubtractive = forceInstance (quote SubtractiveNat)

termToSubExpR : Term → R SubExp
termToSubExpR (a `+ b) = _⟨+⟩_ <$> termToSubExpR a <*> termToSubExpR b
termToSubExpR (a `* b) = _⟨*⟩_ <$> termToSubExpR a <*> termToSubExpR b
termToSubExpR (a `- b) = _⟨-⟩_ <$> termToSubExpR a <*> termToSubExpR b
-- Handle unsolved instances
termToSubExpR (def (quote Semiring._+_) (_ ∷ _ ∷ vArg i@(meta _ _) ∷ vArg a ∷ vArg b ∷ [])) = do
  forceSemiring i
  ⦇ termToSubExpR a ⟨+⟩ termToSubExpR b ⦈
termToSubExpR (def (quote Semiring._*_) (_ ∷ _ ∷ vArg i@(meta _ _) ∷ vArg a ∷ vArg b ∷ [])) = do
  lift $ unify i (def₀ (quote SemiringNat))
  ⦇ termToSubExpR a ⟨*⟩ termToSubExpR b ⦈
termToSubExpR (def (quote Subtractive._-_) (_ ∷ _ ∷ vArg i@(meta _ _) ∷ vArg a ∷ vArg b ∷ [])) = do
  forceSubtractive i
  ⦇ termToSubExpR a ⟨-⟩ termToSubExpR b ⦈
termToSubExpR (def (quote Semiring.zro) (_ ∷ _ ∷ vArg i@(meta _ _) ∷ [])) = do
  forceSemiring i
  pure (lit 0)
termToSubExpR (def (quote Semiring.one) (_ ∷ _ ∷ vArg i@(meta _ _) ∷ [])) = do
  forceSemiring i
  pure (lit 1)
termToSubExpR (def (quote Number.fromNat) (_ ∷ _ ∷ vArg i@(meta _ _) ∷ vArg a ∷ _ ∷ [])) = do
  forceNumber i
  termToSubExpR a
termToSubExpR `0       = pure (lit 0)
termToSubExpR (`suc a) = ⟨suc⟩s <$> termToSubExpR a
termToSubExpR (meta x _) = lift (blockOnMeta x)
termToSubExpR (lit (nat n)) = pure (lit n)
termToSubExpR unknown  = fail
termToSubExpR t = do
  lift $ ensureNoMetas t
  just i ← gets (flip lookup t ∘ snd)
    where nothing → freshS t
  pure (var i)

termToSubEqR : Term → R (SubExp × SubExp)
termToSubEqR (lhs `≡ rhs) = _,_ <$> termToSubExpR lhs <*> termToSubExpR rhs
termToSubEqR (def (quote _≡_) (_ ∷ hArg (meta x _) ∷ _)) = lift (blockOnMeta x)
termToSubEqR _ = fail

termToSubEq : Term → TC (Maybe ((SubExp × SubExp) × List Term))
termToSubEq t = runR (termToSubEqR t)

pattern _`<_ a b = def (quote LessNat) (vArg a ∷ vArg b ∷ [])

termToSubEqnR : Term → R Eqn
termToSubEqnR (def (quote Ord._<_) (_ ∷ _ ∷ vArg i@(meta _ _) ∷ vArg lhs ∷ vArg rhs ∷ [])) = do
  forceInstance (quote OrdNat) i
  ⦇ termToSubExpR lhs :< termToSubExpR rhs ⦈
termToSubEqnR (lhs `< rhs) = _:<_ <$> termToSubExpR lhs <*> termToSubExpR rhs
termToSubEqnR (lhs `≡ rhs) = _:≡_ <$> termToSubExpR lhs <*> termToSubExpR rhs
termToSubEqnR (def (quote _≡_) (_ ∷ hArg (meta x _) ∷ _)) = lift (blockOnMeta x)
termToSubEqnR t = lift (ensureNoMetas t) *> fail

termToSubEqn : Term → TC (Maybe (Eqn × List Term))
termToSubEqn t = runR (termToSubEqnR t)

private
  lower : Nat → Term → R Term
  lower 0 = pure
  lower i = liftMaybe ∘ strengthen i

termToSubHypsR′ : Nat → Term → R (List Eqn)
termToSubHypsR′ i (pi (vArg hyp) (abs _ a)) =
  _∷_ <$> (termToSubEqnR =<< lower i hyp) <*> termToSubHypsR′ (suc i) a
termToSubHypsR′ _ (meta x _) = lift (blockOnMeta x)
termToSubHypsR′ i a = [_] <$> (termToSubEqnR =<< lower i a)

termToSubHypsR : Term → R (List Eqn)
termToSubHypsR = termToSubHypsR′ 0

termToSubHyps : Term → TC (Maybe (List Eqn × List Term))
termToSubHyps t = runR (termToSubHypsR t)

instance
  QuotableSubExp : Quotable SubExp
  ` {{QuotableSubExp}} (var x) = con (quote SubExp.var) (vArg (` x) ∷ [])
  ` {{QuotableSubExp}} (lit n) = con (quote SubExp.lit) (vArg (` n) ∷ [])
  ` {{QuotableSubExp}} (e ⟨+⟩ e₁) = con (quote SubExp._⟨+⟩_) (map defaultArg $ ` e ∷ ` e₁ ∷ [])
  ` {{QuotableSubExp}} (e ⟨-⟩ e₁) = con (quote SubExp._⟨-⟩_) (map defaultArg $ ` e ∷ ` e₁ ∷ [])
  ` {{QuotableSubExp}} (e ⟨*⟩ e₁) = con (quote SubExp._⟨*⟩_) (map defaultArg $ ` e ∷ ` e₁ ∷ [])

  QuotableEqn : Quotable Eqn
  ` {{QuotableEqn}} (a :≡ b) = con (quote _:≡_) (vArg (` a) ∷ vArg (` b) ∷ [])
  ` {{QuotableEqn}} (a :< b) = con (quote _:<_) (vArg (` a) ∷ vArg (` b) ∷ [])


{-# OPTIONS --safe #-}

module Definition.Typed.Consequences.TypeUnicity where

open import Definition.Untyped hiding (U≢ℕ; U≢Π; U≢ne; ℕ≢Π; ℕ≢ne; Π≢ne; U≢Empty; ℕ≢Empty; Empty≢Π; Empty≢ne)
open import Definition.Untyped.Properties using (subst-Univ-either)
open import Definition.Typed
open import Definition.Typed.Properties
open import Definition.Typed.Weakening
open import Definition.Typed.Consequences.Equality
import Definition.Typed.Consequences.Inequality as Ineq
open import Definition.Typed.Consequences.Inversion
open import Definition.Typed.Consequences.Injectivity
open import Definition.Typed.Consequences.NeTypeEq
open import Definition.Typed.Consequences.Syntactic
open import Definition.Typed.Consequences.PiNorm
open import Definition.Typed.Consequences.Substitution
open import Definition.Conversion.Stability

open import Tools.Product
open import Tools.Empty
open import Tools.Sum using (_⊎_; inj₁; inj₂)
import Tools.PropositionalEquality as PE

type-uniq : ∀ {Γ t T₁ T₂ r₁ r₂ l₁ l₂} → Γ ⊢ t ∷ T₁ ^ [ r₁ , l₁ ] → Γ ⊢ t ∷ T₂ ^ [ r₂ , l₂ ] →
                 r₁ PE.≡ r₂ × l₁ PE.≡ l₂ × Γ ⊢ T₁ ≡ T₂ ^ [ r₁ , l₁ ]
type-uniq (univ 0<1 x) (univ 0<1 x') = PE.refl , PE.refl , refl (Ugenⱼ x)
type-uniq (ℕⱼ x) (ℕⱼ x₁) = PE.refl , PE.refl , refl (Ugenⱼ x)
type-uniq (Emptyⱼ x) (Emptyⱼ x₁) = PE.refl , PE.refl , refl (Ugenⱼ x)
type-uniq (Πⱼ x ▹ x₁ ▹ X ▹ X₁) (Πⱼ x₂ ▹ x₃ ▹ Y ▹ Y₁) =
    let _ , _ , eU = type-uniq X₁ Y₁
        er , el = Uinjectivity eU
    in PE.refl , PE.refl , PE.subst (λ r → _ ⊢ _ ≡ Univ r _ ^ _ ) er (refl ((Ugenⱼ (wfTerm Y))) )
type-uniq (∃ⱼ X ▹ X₁) (∃ⱼ Y ▹ Y₁) =
    let _ , enextl , eU = type-uniq X Y
        el = next-inj enextl
    in PE.refl , enextl , PE.subst (λ l → _ ⊢ _ ≡ SProp l ^ _ ) el (refl ((Ugenⱼ (wfTerm Y))) )
type-uniq (var xx x) (var _ y) =
    let T≡T , e = varTypeEq′ x y
        er , el = typelevel-injectivity e
    in er , el , PE.subst (λ A → _ ⊢ _ ≡ A ^ _ ) T≡T (refl (syntacticTerm (var xx x)))
type-uniq (lamⱼ x x₁ x₂ X) (lamⱼ y y₁ y₂ Y) =
    let _ , _ , F≡F = type-uniq (un-univ x₂) (un-univ y₂)
        erF , elF = Uinjectivity F≡F
        erG , elG , G≡G = type-uniq X (PE.subst₂ (λ r l → _ ∙ _ ^ [ r , ι l ] ⊢ _ ∷ _ ^ _) (PE.sym erF) (PE.sym elF) Y)
    in erG , PE.refl , PE.subst₃ (λ rF lF lG → _ ⊢ _ ≡  Π _ ^ rF ° lF ▹ _ ° lG ° _ ^ _) erF elF (ιinj elG)
                                 (univ (Π-cong x x₁ x₂ (refl (un-univ x₂)) (un-univ≡ G≡G)))
type-uniq (X ∘ⱼ X₁) (Y ∘ⱼ Y₁) =
    let er , _ , Π≡Π = type-uniq X Y
        F≡F , erF , elF , elG , G≡G = injectivity Π≡Π
    in er , PE.cong _ elG , (substitutionEq G≡G (substRefl (singleSubst X₁)) (wfTerm X₁))
type-uniq {Γ} ⦅ x , x₁ , X , X₁ ⦆ⱼ (⦅_,_,_,_⦆ⱼ {F = F} {G = G} y y₁ Y Y₁)  =
    let _ , el , F≡F = type-uniq X Y
        _ , el' , G≡G = type-uniq (un-univ x₁) (un-univ (stability (reflConEq (wf x) ∙ sym F≡F)
                                                         (PE.subst (λ l → Γ ∙ F ^ [ % , l ] ⊢ G ^ [ % , l ]) (PE.sym el) y₁)))
    in PE.refl , el , univ (∃-cong x (un-univ≡ F≡F) (un-univ≡ (refl x₁)))
type-uniq (fstⱼ X X₁ X₂) (fstⱼ Y Y₁ Y₂) =
    let er , el , ∃≡∃ = type-uniq X₂ Y₂
        F≡F , _ = ∃injectivity ∃≡∃
    in PE.refl , el , F≡F
type-uniq (sndⱼ X X₁ X₂) (sndⱼ Y Y₁ Y₂) =
    let er , el , ∃≡∃ = type-uniq X₂ Y₂
        F≡F , G≡G = ∃injectivity ∃≡∃
    in PE.refl , el , substitutionEq G≡G (substRefl (singleSubst (fstⱼ X X₁ X₂))) (wfTerm X)
type-uniq (zeroⱼ x) (zeroⱼ x₁) = PE.refl , PE.refl , refl (univ (ℕⱼ x))
type-uniq (sucⱼ X) (sucⱼ Y) = PE.refl , PE.refl , refl (univ (ℕⱼ (wfTerm X)))
type-uniq (natrecⱼ x X X₁ X₂) (natrecⱼ y Y Y₁ Y₂) =
    let _ , _ , U≡U = type-uniq (un-univ x) (un-univ y)
        er , _ = Uinjectivity U≡U
    in er , PE.refl , refl (substitution x (singleSubst X₂) (wfTerm X) )
type-uniq (Emptyrecⱼ x X) (Emptyrecⱼ y Y) =
    let _ , _ , U≡U = type-uniq (un-univ x) (un-univ y)
        er , _ = Uinjectivity U≡U
    in er , PE.refl , refl x
type-uniq (Idⱼ X X₁ X₂) (Idⱼ Y Y₁ Y₂) =
    let _ , enl , U≡U = type-uniq X Y
        el = next-inj enl
    in PE.refl , enl , PE.subst (λ l → _ ⊢ _ ≡ SProp l ^ _) el (refl (Ugenⱼ (wfTerm X)))
type-uniq (Idreflⱼ X) (Idreflⱼ Y) =
    let _ , el , _ = type-uniq X Y
    in PE.refl , el , refl (syntacticTerm (Idreflⱼ X))
type-uniq (transpⱼ x x₁ X X₁ X₂ X₃) (transpⱼ x₂ x₃ Y Y₁ Y₂ Y₃) =
    let _ , el , _ = type-uniq X Y
    in PE.refl , el , refl (substitution x₁ (singleSubst X₂) (wfTerm X))
type-uniq (castⱼ X X₁ X₂ X₃) (castⱼ Y Y₁ Y₂ Y₃) =
    let er , _ , _ = type-uniq X₃ Y₃
    in er , PE.refl , refl (univ X₁)
type-uniq (castreflⱼ X X₁) (castreflⱼ Y Y₁) = PE.refl , PE.refl , refl (syntacticTerm (castreflⱼ X X₁))
type-uniq (conv X x) Y = let er , el , eA = type-uniq X Y in er , el , trans (sym x) eA
type-uniq X (conv Y y) =
    let er , el , eA = type-uniq X Y
    in er , el , trans eA (PE.subst₂ (λ r l → _ ⊢ _ ≡ _ ^ [ r , l ]) (PE.sym er) (PE.sym el) y)


data D : Set where
  @0 c : D

-- The following definition should be rejected. Matching on an erased
-- constructor in an *erased* position should not on its own make it
-- possible to use erased definitions in the right-hand side.

f : @0 D → D
f c = c

x : D
x = f c


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

module Util where

open import Cubical.Core.Everything using (_≡_; Level; Type; Σ; _,_; fst; snd; _≃_; ~_)

open import Cubical.Foundations.Prelude     using (refl; sym; _∙_; cong; transport; subst; funExt; transp; I; i0; i1)
--open import Cubical.Foundations.Function    using (_∘_)
open import Cubical.Foundations.Univalence  using (ua)
open import Cubical.Foundations.Isomorphism using (iso; Iso; isoToPath; section; retract; isoToEquiv)

open import Agda.Primitive       using (Level)
open import Data.Fin             using (Fin; #_; toℕ; inject; fromℕ; fromℕ<; inject₁) renaming (zero to fz; suc to fsuc)
open import Data.Bool            using (Bool; true; false; if_then_else_)
open import Data.Integer         using (ℤ; +_; -[1+_]; _-_; ∣_∣; -_)
open import Data.List            using (List; concat; replicate; []; _∷_; _∷ʳ_; map; _++_; reverse)
open import Data.Maybe           using (Maybe; just; nothing)
open import Data.Nat             using (ℕ; zero; suc; _+_; _*_; _<ᵇ_; _≤ᵇ_; _≡ᵇ_; _<?_; _≟_; _∸_; _<_; s≤s; z≤n; _⊓_)
open import Data.Nat.DivMod      using (_mod_)
open import Data.Nat.Properties  using (≤-step; ≤-trans; ≤-refl)
open import Data.Product         using (_×_; _,_)
open import Data.Vec             using (Vec; _∷_; []; zip; last) renaming (concat to cat; replicate to rep; map to vmap; _∷ʳ_ to _v∷ʳ_)
open import Relation.Nullary     using (yes; no; ¬_)
open import Relation.Nullary.Decidable using (False)
open import Relation.Unary       using (Pred; Decidable)

infixr 9 _∘_

_∘_ : {ℓ : Level}{A : Type ℓ}{B : A → Type ℓ}{C : (a : A) → B a → Type ℓ}
  (g : {a : A} → (b : B a) → C a b) → (f : (a : A) → B a) → (a : A) → C a (f a)
g ∘ f = λ x → g (f x)
{-# INLINE _∘_ #-}

repeat : {ℓ : Level} {A : Type ℓ} → (n : ℕ) → List A → List A
repeat n = concat ∘ replicate n

repeatV : {ℓ : Level} {A : Type ℓ} {k : ℕ} → (n : ℕ) → Vec A k → Vec A (n * k)
repeatV n = cat ∘ rep {n = n}

-- return index of first element that satisfies predicate or last element if none do
findIndex : {a ℓ : Level} {A : Type a} {n : ℕ} {P : Pred A ℓ} → Decidable P → Vec A (suc n) → Fin (suc n)
findIndex _ (x ∷ [])     = # 0
findIndex P (x ∷ y ∷ ys) with P x
... | yes _ = # 0
... | no  _ = fsuc (findIndex P (y ∷ ys))

-- Returns a list of all adjacent pairs in the original list.
pairs : {ℓ : Level} {A : Type ℓ} → List A → List (A × A)
pairs []           = []
pairs (x ∷ [])     = []
pairs (x ∷ y ∷ xs) = (x , y) ∷ pairs (y ∷ xs)

-- Returns a list of all pairs in the original list.
allPairs : {ℓ : Level} {A : Type ℓ} → List A → List (A × A)
allPairs [] = []
allPairs (x ∷ xs) = map (x ,_) xs ++ allPairs xs

-- Returns a singleton list of the pair of the first and last element if the list has at least 2 elements,
-- or the empty list otherwise.
firstLast : {ℓ : Level} {A : Type ℓ} → List A → List (A × A)
firstLast []       = []
firstLast (x ∷ xs) with reverse xs
... | []     = []
... | y ∷ ys = (x , y) ∷ []

-- Returns a list of all adjacent pairs in the original list, prepended by the pair of the first and last elements.
◯pairs : {ℓ : Level} {A : Type ℓ} → List A → List (A × A)
◯pairs xs = firstLast xs ++ pairs xs

-- Returns a list of the first element paired with all later elements, in order.
firstPairs : {ℓ : Level} {A : Type ℓ} → List A → List (A × A)
firstPairs []       = []
firstPairs (x ∷ xs) = map (x ,_) xs

-- Basic Boolean Filter and Elem
filter : {ℓ : Level} {A : Type ℓ} → (A → Bool) → List A → List A
filter f []       = []
filter f (x ∷ xs) = if f x then x ∷ filter f xs else filter f xs

infix 4 _∈_via_
_∈_via_ : {ℓ : Level} {A : Type ℓ} → A → List A → (A → A → Bool) → Bool
x ∈ []     via f = false
x ∈ y ∷ ys via f = if f x y then true else x ∈ ys via f

concatMaybe : {ℓ : Level} {A : Type ℓ} → List (Maybe A) → List A
concatMaybe []             = []
concatMaybe (nothing ∷ xs) = concatMaybe xs
concatMaybe (just x  ∷ xs) = x ∷ concatMaybe xs

listMin : {ℓ : Level} {A : Type ℓ} → (A → ℕ) → List A → Maybe A
listMin f [] = nothing
listMin f (x ∷ xs) with listMin f xs
... | nothing = just x
... | just y  = if f x <ᵇ f y then just x else just y

fins : (k : ℕ) → Vec (Fin k) k
fins zero    = []
fins (suc k) = fz ∷ vmap fsuc (fins k)

fins' : (n : ℕ) → (k : Fin n) → Vec (Fin n) (toℕ k)
fins' n k = vmap inject (fins (toℕ k))

finSuc : {n : ℕ} → Fin (suc n) → Fin (suc n)
finSuc {n} m with suc (toℕ m) <? suc n
... | yes x = fromℕ< x
... | no  _  = fz

_+N_ : {n : ℕ} → Fin (suc n) → ℕ → Fin (suc n)
a +N zero  = a
a +N suc b = finSuc a +N b

∣-∣helper : (n : ℕ) → ℕ → ℕ → ℕ
∣-∣helper n a b with a ≤ᵇ b
... | true  = (b ∸ a) ⊓ ((n + a) ∸ b)
... | false = (a ∸ b) ⊓ ((n + b) ∸ a)

⟨_⟩∣_-_∣ : (n : ℕ) → Fin n → Fin n → ℕ
⟨_⟩∣_-_∣ n a b = ∣-∣helper n (toℕ a) (toℕ b)

n∸k<n : (n k : ℕ) → (suc n) ∸ (suc k) < suc n
n∸k<n zero    zero    = s≤s z≤n
n∸k<n (suc n) zero    = s≤s (n∸k<n n zero)
n∸k<n zero    (suc k) = s≤s z≤n
n∸k<n (suc n) (suc k) = ≤-trans (n∸k<n n k) (≤-step ≤-refl)

opposite' : ∀ {n} → Fin n → Fin n
opposite' {suc n} fz       = fz
opposite' {suc n} (fsuc k) = fromℕ< (n∸k<n n (toℕ k))

-- opposite "i" = "n - i" (i.e. the additive inverse).
opposite : ∀ {n} → Fin n → Fin n
opposite {suc n} fz              = fz
opposite {suc n} (fsuc fz)       = fromℕ n
opposite {suc n} (fsuc (fsuc i)) = inject₁ (opposite (fsuc i))

_modℕ_ : (dividend : ℤ) (divisor : ℕ) {≢0 : False (divisor ≟ 0)} → Fin divisor
((+ n)    modℕ d) {d≠0} = (n mod d) {d≠0}
(-[1+ n ] modℕ d) {d≠0} = opposite ((suc n mod d) {d≠0})

zipWithIndex : {ℓ : Level} {A : Type ℓ} {k : ℕ} → Vec A k → Vec (Fin k × A) k
zipWithIndex {k = k} = zip (fins k)

iter : {ℓ : Level} {A : Type ℓ} → (A → A) → ℕ → A → List A
iter f zero    x = x ∷ []
iter f (suc n) x = x ∷ iter f n (f x)

rotateLeft : {ℓ : Level} {A : Type ℓ} → List A → List A
rotateLeft []       = []
rotateLeft (x ∷ xs) = xs ∷ʳ x

rotateRight : {ℓ : Level} {A : Type ℓ} → List A → List A
rotateRight = reverse ∘ rotateLeft ∘ reverse

vrotateLeft : {ℓ : Level} {A : Type ℓ} {k : ℕ} → Vec A k → Vec A k
vrotateLeft {k = zero}  []       = []
vrotateLeft {k = suc k} (x ∷ xs) = xs v∷ʳ x

vrotateRight : {ℓ : Level} {A : Type ℓ} {k : ℕ} → Vec A k → Vec A k
vrotateRight {k = zero}  []          = []
vrotateRight {k = suc k} xs@(_ ∷ ys) = last xs ∷ ys


-- Andreas, 2015-03-17

open import Common.Size

data ⊥ : Set where

data D (i : Size) : Set where
  c : Size< i → D i

-- This definition of size predecessor should be forbidden...
module _ (i : Size) where
  postulate
    pred : Size< i

-- ...otherwise the injectivity test loops here.
iter : ∀ i → D i → ⊥
iter i (c j) = iter j (c (pred j))

loop : Size → ⊥
loop i = iter i (c (pred i))

absurd : ⊥
absurd = FIXME loop ∞

-- Testcase temporarily mutilated, original error
-- -Issue1428c.agda:13,5-19
-- -We don't like postulated sizes in parametrized modules.
-- +Issue1428c.agda:23,10-15
-- +Not in scope:
-- +  FIXME at Issue1428c.agda:23,10-15
-- +when scope checking FIXME


open import Data.Product using ( proj₁ ; proj₂ )
open import Data.Sum using ( _⊎_ ; inj₁ ; inj₂ )
open import Relation.Binary.PropositionalEquality using ( refl )
open import Web.Semantic.DL.ABox.Interp using ( ⌊_⌋ ; ind ; _*_ )
open import Web.Semantic.DL.ABox.Interp.Morphism using ( _,_ )
open import Web.Semantic.DL.ABox.Model using
  ( _⊨a_ ; on-bnode ; bnodes ; _,_ ; ⊨a-resp-≲ )
open import Web.Semantic.DL.Category.Composition using ( _∙_ )
open import Web.Semantic.DL.Category.Properties.Composition.Lemmas using
  ( compose-left ; compose-right ; compose-resp-⊨a )
open import Web.Semantic.DL.Category.Properties.Tensor.Lemmas using
  ( tensor-up ; tensor-down ; tensor-resp-⊨a )
open import Web.Semantic.DL.Category.Object using ( Object ; IN ; fin )
open import Web.Semantic.DL.Category.Morphism using
  ( _⇒_ ; BN ; impl ; _⊑_ ; _≣_ ; _,_ )
open import Web.Semantic.DL.Category.Tensor using ( _⊗_ ; _⟨⊗⟩_ )
open import Web.Semantic.DL.Category.Unit using ( I )
open import Web.Semantic.DL.Category.Wiring using
  ( wires-≈ ; wires-≈⁻¹ ; assoc )
open import Web.Semantic.DL.Signature using ( Signature )
open import Web.Semantic.DL.TBox using ( TBox )
open import Web.Semantic.DL.TBox.Interp using
  ( Δ ; _⊨_≈_ ; ≈-refl ; ≈-refl′ ; ≈-sym )
open import Web.Semantic.DL.TBox.Interp.Morphism using ( ≲-refl )
open import Web.Semantic.Util using
  ( _∘_ ; False ; ⊎-assoc ; ⊎-assoc⁻¹
  ; _⊕_⊕_ ; inode ; bnode ; enode ; left ; right ; up ; down )

module Web.Semantic.DL.Category.Properties.Tensor.AssocNatural
  {Σ : Signature} {S T : TBox Σ} where

assoc-natural : ∀ {A₁ A₂ A₃ B₁ B₂ B₃ : Object S T}
  (F₁ : A₁ ⇒ B₁) (F₂ : A₂ ⇒ B₂) (F₃ : A₃ ⇒ B₃) →
    (((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) ∙ assoc B₁ B₂ B₃ ≣
      assoc A₁ A₂ A₃ ∙ (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)))
assoc-natural {A₁} {A₂} {A₃} {B₁} {B₂} {B₃} F₁ F₂ F₃ = (LHS⊑RHS , RHS⊑LHS) where

  LHS⊑RHS : ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) ∙ assoc B₁ B₂ B₃ ⊑
    assoc A₁ A₂ A₃ ∙ (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃))
  LHS⊑RHS J J⊨STA J⊨LHS = (f , J⊨RHS) where

    f : (False ⊕ (IN A₁ ⊎ (IN A₂ ⊎ IN A₃)) ⊕ (BN F₁ ⊎ (BN F₂ ⊎ BN F₃))) → Δ ⌊ J ⌋
    f (inode ())
    f (bnode x) = ind J (inode (⊎-assoc⁻¹ x))
    f (enode v) = ind J (bnode (inode (⊎-assoc⁻¹ v)))

    lemma₁ : ∀ x →
      ⌊ J ⌋ ⊨ ind J (left (up (up x))) ≈
        on-bnode f (ind J) (right (up x))
    lemma₁ (inode x) = ≈-refl ⌊ J ⌋
    lemma₁ (bnode v) = ≈-refl ⌊ J ⌋
    lemma₁ (enode y) = wires-≈ ⊎-assoc⁻¹
      (proj₂ (fin (B₁ ⊗ (B₂ ⊗ B₃))) (inj₁ y))
      (compose-right ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) (assoc B₁ B₂ B₃) J J⊨LHS)

    lemma₂ : ∀ x →
      ⌊ J ⌋ ⊨ ind J (left (up (down x))) ≈
        on-bnode f (ind J) (right (down (up x)))
    lemma₂ (inode x) = ≈-refl ⌊ J ⌋
    lemma₂ (bnode v) = ≈-refl ⌊ J ⌋
    lemma₂ (enode y) = wires-≈ ⊎-assoc⁻¹
      (proj₂ (fin (B₁ ⊗ (B₂ ⊗ B₃))) (inj₂ (inj₁ y)))
      (compose-right ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) (assoc B₁ B₂ B₃) J J⊨LHS)

    lemma₃ : ∀ x →
      ⌊ J ⌋ ⊨ ind J (left (down x)) ≈
        on-bnode f (ind J) (right (down (down x)))
    lemma₃ (inode x) = ≈-refl ⌊ J ⌋
    lemma₃ (bnode v) = ≈-refl ⌊ J ⌋
    lemma₃ (enode y) = wires-≈ ⊎-assoc⁻¹
      (proj₂ (fin (B₁ ⊗ (B₂ ⊗ B₃))) (inj₂ (inj₂ y)))
      (compose-right ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) (assoc B₁ B₂ B₃) J J⊨LHS)

    J⊨RHS : bnodes J f ⊨a impl (assoc A₁ A₂ A₃ ∙ (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)))
    J⊨RHS = compose-resp-⊨a (assoc A₁ A₂ A₃) (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) (bnodes J f)
      (wires-≈⁻¹ ⊎-assoc⁻¹ (λ x → ≈-refl ⌊ J ⌋) (proj₁ (fin (A₁ ⊗ (A₂ ⊗ A₃)))))
      (tensor-resp-⊨a F₁ (F₂ ⟨⊗⟩ F₃) (right * bnodes J f)
        (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , lemma₁) (impl F₁)
          (tensor-up F₁ F₂ (up * left * J)
            (tensor-up (F₁ ⟨⊗⟩ F₂) F₃ (left * J)
              (compose-left ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) (assoc B₁ B₂ B₃) J J⊨LHS))))
        (tensor-resp-⊨a F₂ F₃ (down * right * bnodes J f)
          (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , lemma₂) (impl F₂)
            (tensor-down F₁ F₂ (up * left * J)
              (tensor-up (F₁ ⟨⊗⟩ F₂) F₃ (left * J)
                (compose-left ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) (assoc B₁ B₂ B₃) J J⊨LHS))))
          (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , lemma₃) (impl F₃)
            (tensor-down (F₁ ⟨⊗⟩ F₂) F₃ (left * J)
              (compose-left ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) (assoc B₁ B₂ B₃) J J⊨LHS)))))

  RHS⊑LHS : assoc A₁ A₂ A₃ ∙ (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) ⊑
    ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) ∙ assoc B₁ B₂ B₃
  RHS⊑LHS J J⊨STA J⊨RHS = (f , J⊨LHS) where

    f : (((BN F₁ ⊎ BN F₂) ⊎ BN F₃) ⊕ ((IN B₁ ⊎ IN B₂) ⊎ IN B₃) ⊕ False) → Δ ⌊ J ⌋
    f (inode v) = ind J (bnode (enode (⊎-assoc v)))
    f (bnode y) = ind J (enode (⊎-assoc y))
    f (enode ())

    lemma₀ : ∀ x →
      ⌊ J ⌋ ⊨ ind J (enode (⊎-assoc (⊎-assoc⁻¹ x))) ≈ ind J (enode x)
    lemma₀ (inj₁ x) = ≈-refl ⌊ J ⌋
    lemma₀ (inj₂ (inj₁ x)) = ≈-refl ⌊ J ⌋
    lemma₀ (inj₂ (inj₂ y)) = ≈-refl ⌊ J ⌋

    lemma₁ : ∀ x → ⌊ J ⌋ ⊨ ind J (right (up x)) ≈
      on-bnode f (ind J) (left (up (up x)))
    lemma₁ (inode x) = ≈-sym ⌊ J ⌋ (wires-≈ ⊎-assoc⁻¹
      (proj₂ (fin (A₁ ⊗ (A₂ ⊗ A₃))) (inj₁ x))
      (compose-left (assoc A₁ A₂ A₃) (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) J J⊨RHS))
    lemma₁ (bnode v) = ≈-refl ⌊ J ⌋
    lemma₁ (enode y) = ≈-refl ⌊ J ⌋

    lemma₂ : ∀ x → ⌊ J ⌋ ⊨ ind J (right (down (up x))) ≈
      on-bnode f (ind J) (left (up (down x)))
    lemma₂ (inode x) = ≈-sym ⌊ J ⌋ (wires-≈ ⊎-assoc⁻¹
      (proj₂ (fin (A₁ ⊗ (A₂ ⊗ A₃))) (inj₂ (inj₁ x)))
      (compose-left (assoc A₁ A₂ A₃) (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) J J⊨RHS))
    lemma₂ (bnode v) = ≈-refl ⌊ J ⌋
    lemma₂ (enode y) = ≈-refl ⌊ J ⌋

    lemma₃ : ∀ x → ⌊ J ⌋ ⊨ ind J (right (down (down x))) ≈
      on-bnode f (ind J) (left (down x))
    lemma₃ (inode x) = ≈-sym ⌊ J ⌋ (wires-≈ ⊎-assoc⁻¹
      (proj₂ (fin (A₁ ⊗ (A₂ ⊗ A₃))) (inj₂ (inj₂ x)))
      (compose-left (assoc A₁ A₂ A₃) (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) J J⊨RHS))
    lemma₃ (bnode v) = ≈-refl ⌊ J ⌋
    lemma₃ (enode y) = ≈-refl ⌊ J ⌋

    J⊨LHS : bnodes J f ⊨a impl (((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) ∙ assoc B₁ B₂ B₃)
    J⊨LHS = compose-resp-⊨a ((F₁ ⟨⊗⟩ F₂) ⟨⊗⟩ F₃) (assoc B₁ B₂ B₃) (bnodes J f)
      (tensor-resp-⊨a (F₁ ⟨⊗⟩ F₂) F₃ (left * bnodes J f)
        (tensor-resp-⊨a F₁ F₂ (up * left * bnodes J f)
          (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , lemma₁) (impl F₁)
            (tensor-up F₁ (F₂ ⟨⊗⟩ F₃) (right * J)
              (compose-right (assoc A₁ A₂ A₃) (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) J J⊨RHS)))
          (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , lemma₂) (impl F₂)
            (tensor-up F₂ F₃ (down * right * J)
              (tensor-down F₁ (F₂ ⟨⊗⟩ F₃) (right * J)
                (compose-right (assoc A₁ A₂ A₃) (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) J J⊨RHS)))))
       (⊨a-resp-≲ (≲-refl ⌊ J ⌋ , lemma₃) (impl F₃)
         (tensor-down F₂ F₃ (down * right * J)
           (tensor-down F₁ (F₂ ⟨⊗⟩ F₃) (right * J)
             (compose-right (assoc A₁ A₂ A₃) (F₁ ⟨⊗⟩ (F₂ ⟨⊗⟩ F₃)) J J⊨RHS)))))
      (wires-≈⁻¹ ⊎-assoc⁻¹ lemma₀ (proj₁ (fin (B₁ ⊗ (B₂ ⊗ B₃)))))


-- MIT License

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

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

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

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

{-# OPTIONS --guardedness #-}

open import Data.Product
open import Data.Empty
open import Data.Sum
open import Data.Vec
open import Data.Fin
open import Data.Bool renaming (Bool to 𝔹)
open import Relation.Unary using (_∈_; _⊆_; _∉_)
open import Relation.Binary.Definitions
open import Relation.Binary.Construct.Closure.ReflexiveTransitive
open import Relation.Binary.PropositionalEquality
open import Relation.Nullary

open import Common

open import is-lib.InfSys

module FairCompliance-IS {𝕋 : Set} (message : Message 𝕋) where

  open import SessionType message
  open import Session message
  open import Transitions message

  private
    U : Set
    U = SessionType × SessionType

  data FCompIS-RN : Set where
    client-end : FCompIS-RN
    oi io : FCompIS-RN

  data FCompCOIS-RN : Set where
    co-oi co-io : FCompCOIS-RN

  client-end-r : FinMetaRule U
  client-end-r .Ctx = Σ[ (S , T) ∈ SessionType × SessionType ] Win S × Defined T
  client-end-r .comp ((S , T) , _) =
    [] ,
    --------------------
    (S , T)

  OI-r : MetaRule U
  OI-r .Ctx = Σ[ (f , _) ∈ Continuation × Continuation ] Witness f
  OI-r .Pos ((f , _) , _) = Σ[ t ∈ 𝕋 ] t ∈ dom f
  OI-r .prems ((f , g) , _) (t , _) = f t .force , g t .force
  OI-r .conclu ((f , g) , _) = out f , inp g

  IO-r : MetaRule U
  IO-r .Ctx = Σ[ (_ , g) ∈ Continuation × Continuation ] Witness g
  IO-r .Pos ((_ , g) , _) = Σ[ t ∈ 𝕋 ] t ∈ dom g
  IO-r .prems ((f , g) , _) (t , _) = f t .force , g t .force
  IO-r .conclu ((f , g) , _) = inp f , out g

  co-OI-r : FinMetaRule U
  co-OI-r .Ctx = Σ[ (f , _ , x) ∈ Continuation × Continuation × 𝕋 ] x ∈ dom f
  co-OI-r .comp ((f , g , x) , _) =
    (f x .force , g x .force) ∷ [] ,
    --------------------
    (out f , inp g)

  co-IO-r : FinMetaRule U
  co-IO-r .Ctx = Σ[ (_ , g , x) ∈ Continuation × Continuation × 𝕋 ] x ∈ dom g
  co-IO-r .comp ((f , g , x) , _) =
    (f x .force , g x .force) ∷ [] ,
    --------------------
    (inp f , out g)

  FCompIS : IS U
  FCompIS .Names = FCompIS-RN
  FCompIS .rules client-end = from client-end-r
  FCompIS .rules oi = OI-r
  FCompIS .rules io = IO-r

  FCompCOIS : IS U
  FCompCOIS .Names = FCompCOIS-RN
  FCompCOIS .rules co-oi = from co-OI-r
  FCompCOIS .rules co-io = from co-IO-r

  _⊢_ : SessionType → SessionType → Set
  S ⊢ T = FCoInd⟦ FCompIS , FCompCOIS ⟧ (S , T)

  _⊢ᵢ_ : SessionType → SessionType → Set
  S ⊢ᵢ T = Ind⟦ FCompIS ∪ FCompCOIS ⟧ (S , T)

  {- Properties -}

  ¬nil-⊢ : ∀{S} → ¬ (nil ⊢ S)
  ¬nil-⊢ fc with fc .CoInd⟦_⟧.unfold
  ... | client-end , ((_ , (() , _)) , _) , refl , _

  ⊢ᵢ->succeed : ∀{S T} → S ⊢ᵢ T → MaySucceed (S # T)
  ⊢ᵢ->succeed (fold (inj₁ client-end , ((S , T) , (win , def)) , refl , _)) = (S # T) , ε , win#def win def
  ⊢ᵢ->succeed (fold (inj₁ oi , ((f , g) , (t , ok)) , refl , pr)) =
    let Sys' , red-Sys' , Succ = ⊢ᵢ->succeed (pr (t , ok)) in
    Sys' , sync (out ok) inp ◅ red-Sys' , Succ
  ⊢ᵢ->succeed (fold (inj₁ io , ((f , g) , (t , ok)) , refl , pr)) =
    let Sys' , red-Sys' , Succ = ⊢ᵢ->succeed (pr (t , ok)) in
    Sys' , sync inp (out ok) ◅ red-Sys' , Succ
  ⊢ᵢ->succeed (fold (inj₂ co-oi , (_ , ok-b) , refl , pr)) =
    let Sys' , red-Sys' , Succ = ⊢ᵢ->succeed (pr zero) in
    Sys' , sync (out ok-b) inp ◅ red-Sys' , Succ
  ⊢ᵢ->succeed (fold (inj₂ co-io , (_ , ok-b) , refl , pr)) =
    let Sys' , red-Sys' , Succ = ⊢ᵢ->succeed (pr zero) in
    Sys' , sync inp (out ok-b) ◅ red-Sys' , Succ

  maysucceed->⊢ᵢ : ∀{S T Sys} → Reductions (S # T) Sys → Success Sys → S ⊢ᵢ T
  maysucceed->⊢ᵢ ε (win#def win def) = apply-ind (inj₁ client-end) (_ , (win , def)) λ ()
  maysucceed->⊢ᵢ (sync (out ok) inp ◅ red) Succ =
    let rec = maysucceed->⊢ᵢ red Succ in
    apply-ind (inj₂ co-oi) (_ , ok) λ{zero → rec}
  maysucceed->⊢ᵢ (sync inp (out ok) ◅ red) Succ =
    let rec = maysucceed->⊢ᵢ red Succ in
    apply-ind (inj₂ co-io) (_ , ok) λ{zero → rec}

  {- Soundness -}

  fc-sound : ∀{S T} → S ⊢ T → FairComplianceS (S # T)
  fc-sound fc ε = ⊢ᵢ->succeed (fcoind-to-ind fc)
  fc-sound fc (x ◅ red) with fc .CoInd⟦_⟧.unfold
  ... | client-end , ((_ , (win , def)) , _) , refl , _ = ⊥-elim (success-not-reduce (win#def win def) x)
  fc-sound fc (sync (out ok) (inp {x = t}) ◅ red) | oi , (((f , _) , _) , _) , refl , pr = fc-sound (pr (t , ok)) red
  fc-sound fc (sync (inp {x = t}) (out ok) ◅ red) | io , (((_ , g) , _) , _) , refl , pr = fc-sound (pr (t , ok)) red

  {- Boundedness -}

  fc-bounded : ∀{S T} → FairComplianceS (S # T) → S ⊢ᵢ T
  fc-bounded fc =
    let _ , red-Sys , Succ = fc ε in
    maysucceed->⊢ᵢ red-Sys Succ

  {- Consistency -}

  fc-consistent : ∀{S T} → FairComplianceS (S # T) → ISF[ FCompIS ] (λ{(S , T) → FairComplianceS (S # T)}) (S , T)
  fc-consistent fc with fc ε
  ... | _ , ε , win#def win def = client-end , (_ , (win , def)) , refl , λ ()
  ... | _ , sync (out ok) (inp {x = t}) ◅ _ , _ =
    oi , (_ , (t , ok)) , refl , λ (t' , ok') red → fc (sync (out ok') (inp {x = t'}) ◅ red)
  ... | _ , sync (inp {x = t}) (out ok) ◅ _ , _ =
    io , (_ , (t , ok)) , refl , λ (t' , ok') red → fc (sync (inp {x = t'}) (out ok') ◅ red)

  {- Completeness -}

  fc-complete : ∀{S T} → FairComplianceS (S # T) → S ⊢ T
  fc-complete =
    let S = λ{(S , T) → FairComplianceS (S # T)} in
    bounded-coind[ FCompIS , FCompCOIS ] S fc-bounded fc-consistent

  {- Properties -}

  fci->defined : ∀{S T} → S ⊢ᵢ T → Defined S × Defined T
  fci->defined (fold (inj₁ client-end , (_ , (out _ , def)) , refl , _)) = out , def
  fci->defined (fold (inj₁ oi , _ , refl , _)) = out , inp
  fci->defined (fold (inj₁ io , _ , refl , _)) = inp , out
  fci->defined (fold (inj₂ co-oi , _ , refl , _)) = out , inp
  fci->defined (fold (inj₂ co-io , _ , refl , _)) = inp , out

  fc->defined : ∀{S T} → S ⊢ T → Defined S × Defined T
  fc->defined fc = fci->defined (fcoind-to-ind fc)

  no-fc-with-nil : ∀{S} → ¬ (S ⊢ nil)
  no-fc-with-nil fc with fc .CoInd⟦_⟧.unfold
  ... | client-end , ((_ , (_ , ())) , _) , refl , _

  {- Auxiliary for FS -}

  win⊢def : ∀{S} → Defined S → win ⊢ S
  win⊢def ok = apply-fcoind client-end (_ , (Win-win , ok)) λ ()

  ⊢-after-out : ∀{f g t} → t ∈ dom f → out f ⊢ inp g → f t .force ⊢ g t .force
  ⊢-after-out ok fc with fc .CoInd⟦_⟧.unfold
  ... | client-end , ((_ , (out e , _)) , _) , refl , _ = ⊥-elim (e _ ok)
  ... | oi , _ , refl , pr = pr (_ , ok)

  ⊢-after-in : ∀{f g t} → t ∈ dom g → inp f ⊢ out g → f t .force ⊢ g t .force
  ⊢-after-in ok fc with fc .CoInd⟦_⟧.unfold
  ... | client-end , ((_ , (() , _)) , _) , refl , _
  ... | io , _ , refl , pr = pr (_ , ok)


module Issue3295.Incomplete2 where

open import Agda.Builtin.Nat

{-# NON_COVERING #-}
g : Nat → Nat
g zero = zero


{-# OPTIONS --safe #-}

module Definition.Typed.EqualityRelation where

open import Definition.Untyped
open import Definition.Typed
open import Definition.Typed.Weakening using (_∷_⊆_)

-- Generic equality relation used with the logical relation

record EqRelSet : Set₁ where
  constructor eqRel
  field
    ---------------
    -- Relations --
    ---------------

    -- Equality of types
    _⊢_≅_^_   : Con Term → (A B : Term) → TypeInfo → Set

    -- Equality of terms
    _⊢_≅_∷_^_ : Con Term → (t u A : Term) → TypeInfo → Set

    -- Equality of neutral terms
    _⊢_~_∷_^_ : Con Term → (t u A : Term) → TypeInfo → Set

    ----------------
    -- Properties --
    ----------------

    -- Generic equality compatibility
    ~-to-≅ₜ : ∀ {k l A r Γ}
            → Γ ⊢ k ~ l ∷ A ^ r
            → Γ ⊢ k ≅ l ∷ A ^ r

    -- Judgmental conversion compatibility
    ≅-eq  : ∀ {A B r Γ}
          → Γ ⊢ A ≅ B ^ r
          → Γ ⊢ A ≡ B ^ r
    ≅ₜ-eq : ∀ {t u A r Γ}
          → Γ ⊢ t ≅ u ∷ A ^ r
          → Γ ⊢ t ≡ u ∷ A ^ r

    -- Universe
    ≅-univ : ∀ {A B r l Γ}
           → Γ ⊢ A ≅ B ∷ (Univ r l) ^ [ ! , next l ]
           → Γ ⊢ A ≅ B ^ [ r , ι l ]

    ≅-un-univ : ∀ {A B r l Γ}
           → Γ ⊢ A ≅ B ^ [ r , ι l ]
           → Γ ⊢ A ≅ B ∷ (Univ r l) ^ [ ! , next l ]

    -- Symmetry
    ≅-sym  : ∀ {A B Γ r} → Γ ⊢ A ≅ B ^ r → Γ ⊢ B ≅ A ^ r
    ≅ₜ-sym : ∀ {t u A r Γ} → Γ ⊢ t ≅ u ∷ A ^ r → Γ ⊢ u ≅ t ∷ A ^ r
    ~-sym  : ∀ {k l A Γ r} → Γ ⊢ k ~ l ∷ A ^ r → Γ ⊢ l ~ k ∷ A ^ r

    -- Transitivity
    ≅-trans  : ∀ {A B C r Γ} → Γ ⊢ A ≅ B ^ r → Γ ⊢ B ≅ C ^ r → Γ ⊢ A ≅ C ^ r
    ≅ₜ-trans : ∀ {t u v A r Γ} → Γ ⊢ t ≅ u ∷ A ^ r → Γ ⊢ u ≅ v ∷ A ^ r → Γ ⊢ t ≅ v ∷ A ^ r
    ~-trans  : ∀ {k l m A r Γ} → Γ ⊢ k ~ l ∷ A ^ r → Γ ⊢ l ~ m ∷ A ^ r → Γ ⊢ k ~ m ∷ A ^ r

    -- Conversion
    ≅-conv : ∀ {t u A B r Γ} → Γ ⊢ t ≅ u ∷ A ^ r → Γ ⊢ A ≡ B ^ r → Γ ⊢ t ≅ u ∷ B ^ r
    ~-conv : ∀ {k l A B r Γ} → Γ ⊢ k ~ l ∷ A ^ r → Γ ⊢ A ≡ B ^ r → Γ ⊢ k ~ l ∷ B ^ r

    -- Weakening
    ≅-wk  : ∀ {A B r ρ Γ Δ}
          → ρ ∷ Δ ⊆ Γ
          → ⊢ Δ
          → Γ ⊢ A ≅ B ^ r
          → Δ ⊢ wk ρ A ≅ wk ρ B ^ r
    ≅ₜ-wk : ∀ {t u A r ρ Γ Δ}
          → ρ ∷ Δ ⊆ Γ
          → ⊢ Δ
          → Γ ⊢ t ≅ u ∷ A ^ r
          → Δ ⊢ wk ρ t ≅ wk ρ u ∷ wk ρ A ^ r
    ~-wk  : ∀ {k l A r ρ Γ Δ}
          → ρ ∷ Δ ⊆ Γ
          → ⊢ Δ
          → Γ ⊢ k ~ l ∷ A ^ r
          → Δ ⊢ wk ρ k ~ wk ρ l ∷ wk ρ A ^ r

    -- Weak head expansion
    ≅-red : ∀ {A A′ B B′ r Γ}
          → Γ ⊢ A ⇒* A′ ^ r
          → Γ ⊢ B ⇒* B′ ^ r
          → Whnf A′
          → Whnf B′
          → Γ ⊢ A′ ≅ B′ ^ r
          → Γ ⊢ A  ≅ B ^ r

    ≅ₜ-red : ∀ {a a′ b b′ A B l Γ}
           → Γ ⊢ A ⇒* B ^ [ ! , l ]
           → Γ ⊢ a ⇒* a′ ∷ B ^ l
           → Γ ⊢ b ⇒* b′ ∷ B ^ l
           → Whnf B
           → Whnf a′
           → Whnf b′
           → Γ ⊢ a′ ≅ b′ ∷ B ^ [ ! , l ]
           → Γ ⊢ a  ≅ b  ∷ A ^ [ ! , l ]

    -- Large universe type reflexivity
    ≅-U¹refl   : ∀ {r Γ} → ⊢ Γ → Γ ⊢ (Univ r ¹) ≅ (Univ r ¹) ^ [ ! , ∞ ]

    -- Small universe type reflexivity
    ≅-U⁰refl   : ∀ {r Γ} → ⊢ Γ → Γ ⊢ (Univ r ⁰) ≅ (Univ r ⁰) ∷ U ¹ ^ [ ! , ∞ ]

    -- Natural number type reflexivity
    ≅ₜ-ℕrefl  : ∀ {Γ} → ⊢ Γ → Γ ⊢ ℕ ≅ ℕ ∷ U ⁰ ^ [ ! , next ⁰ ]

    -- Empty type reflexivity
    ≅ₜ-Emptyrefl  : ∀ {Γ l} → ⊢ Γ → Γ ⊢ Empty l ≅ Empty l ∷ SProp l ^ [ ! , next l ]

    -- Π-congruence
    ≅ₜ-Π-cong : ∀ {F G H E rF lF r lG l Γ}
              → lF ≤ l
              → lG ≤ l
              → Γ ⊢ F ^ [ rF , ι lF ]
              → Γ ⊢ F ≅ H ∷ (Univ rF lF) ^ [ ! , next lF ]
              → Γ ∙ F ^ [ rF , ι lF ] ⊢ G ≅ E ∷ (Univ r lG) ^ [ ! , next lG ]
              → Γ ⊢ Π F ^ rF ° lF ▹ G ° lG ° l ≅ Π H ^ rF ° lF ▹ E ° lG ° l ∷ (Univ r l) ^ [ ! , next l ]

    -- ∃-congruence
    -- Since ∃ types are always small, no need for a type-level rule
    ≅ₜ-∃-cong : ∀ {F G H E l Γ}
              → Γ ⊢ F ^ [ % , ι l ]
              → Γ ⊢ F ≅ H ∷ SProp l ^ [ ! , next l ]
              → Γ ∙ F ^ [ % , ι l ] ⊢ G ≅ E ∷ SProp l ^ [ ! , next l ]
              → Γ ⊢ ∃ F ▹ G ≅ ∃ H ▹ E ∷ SProp l ^ [ ! , next l ]

    -- Zero reflexivity
    ≅ₜ-zerorefl : ∀ {Γ} → ⊢ Γ → Γ ⊢ zero ≅ zero ∷ ℕ ^ [ ! , ι ⁰ ]

    -- Successor congruence
    ≅-suc-cong : ∀ {m n Γ} → Γ ⊢ m ≅ n ∷ ℕ ^ [ ! , ι ⁰ ] → Γ ⊢ suc m ≅ suc n ∷ ℕ ^ [ ! , ι ⁰ ]

    -- η-equality
    ≅-η-eq : ∀ {f g F G rF lF lG l Γ}
              → lF ≤ l
              → lG ≤ l
              → Γ ⊢ F ^ [ rF , ι lF ]
              → Γ ⊢ f ∷ Π F ^ rF ° lF ▹ G ° lG ° l ^ [ ! , ι l ]
              → Γ ⊢ g ∷ Π F ^ rF ° lF ▹ G ° lG ° l ^ [ ! , ι l ]
              → Function f
              → Function g
              → Γ ∙ F ^ [ rF , ι lF ] ⊢ wk1 f ∘ var 0 ^ l ≅ wk1 g ∘ var 0 ^ l ∷ G ^ [ ! , ι lG ]
              → Γ ⊢ f ≅ g ∷ Π F ^ rF ° lF ▹ G ° lG ° l ^ [ ! , ι l ]

    -- Variable reflexivity
    ~-var : ∀ {x A Γ r} → Γ ⊢ var x ∷ A ^ r → Γ ⊢ var x ~ var x ∷ A ^ r

    -- Application congurence
    ~-app : ∀ {a b f g F G rF lF lG l Γ}
          → Γ ⊢ f ~ g ∷ Π F ^ rF ° lF ▹ G ° lG ° l ^ [ ! , ι l ]
          → Γ ⊢ a ≅ b ∷ F ^ [ rF , ι lF ]
          → Γ ⊢ f ∘ a ^ l ~ g ∘ b ^ l ∷ G [ a ] ^ [ ! , ι lG ]

    -- Natural recursion congurence
    ~-natrec : ∀ {z z′ s s′ n n′ F F′ l Γ}
             → Γ ∙ ℕ ^ [ ! , ι ⁰ ] ⊢ F ≅ F′ ^ [ ! , ι l ]
             → Γ     ⊢ z ≅ z′ ∷ F [ zero ] ^ [ ! , ι l ]
             → Γ     ⊢ s ≅ s′ ∷ Π ℕ ^ ! ° ⁰ ▹ (F ^ ! ° l ▹▹ F [ suc (var 0) ]↑ ° l ° l ) ° l ° l ^ [ ! , ι l ]
             → Γ     ⊢ n ~ n′ ∷ ℕ ^ [ ! , ι ⁰ ]
             → Γ     ⊢ natrec l F z s n ~ natrec l F′ z′ s′ n′ ∷ F [ n ] ^ [ ! , ι l ]

    -- Empty recursion congurence
    ~-Emptyrec : ∀ {e e′ F F′ l lEmpty Γ}
             → Γ ⊢ F ≅ F′ ^ [ ! , ι l ]
             → Γ ⊢ e ∷ Empty lEmpty ^ [ % , ι lEmpty ]
             → Γ ⊢ e′ ∷ Empty lEmpty ^ [ % , ι lEmpty ]
             → Γ     ⊢ Emptyrec l lEmpty F e ~ Emptyrec l lEmpty F′ e′ ∷ F ^ [ ! , ι l ]

    -- Id congruences
    ~-Id  : ∀ {A A' l t t' u u' Γ}
          → Γ ⊢ A ~ A' ∷ Univ ! l ^ [ ! , next l ]
          → Γ ⊢ t ≅ t' ∷ A ^ [ ! , ι l ]
          → Γ ⊢ u ≅ u' ∷ A ^ [ ! , ι l ]
          → Γ ⊢ Id A t u ~ Id A' t' u' ∷ SProp l ^ [ ! , next l ]

    ~-Idℕ : ∀ {t t' u u' Γ}
          → ⊢ Γ
          → Γ ⊢ t ~ t' ∷ ℕ ^ [ ! , ι ⁰ ]
          → Γ ⊢ u ≅ u' ∷ ℕ ^ [ ! , ι ⁰ ]
          → Γ ⊢ Id ℕ t u ~ Id ℕ t' u' ∷ SProp ⁰ ^ [ ! , next ⁰ ]

    ~-Idℕ0 : ∀ {u u' Γ}
           → ⊢ Γ
           → Γ ⊢ u ~ u' ∷ ℕ ^ [ ! , ι ⁰ ]
           → Γ ⊢ Id ℕ zero u ~ Id ℕ zero u' ∷ SProp ⁰ ^ [ ! , next ⁰ ]

    ~-IdℕS : ∀ {t t' u u' Γ}
           → ⊢ Γ
           → Γ ⊢ t ≅ t' ∷ ℕ ^ [ ! , ι ⁰ ]
           → Γ ⊢ u ~ u' ∷ ℕ ^ [ ! , ι ⁰ ]
           → Γ ⊢ Id ℕ (suc t) u ~ Id ℕ (suc t') u' ∷ SProp ⁰ ^ [ ! , next ⁰ ]

    ~-IdU : ∀ {t t' u u' Γ} →
          let l = ⁰ in
          let l' = ¹ in
            ⊢ Γ
          → Γ ⊢ t ~ t' ∷ U l ^ [ ! , next l ]
          → Γ ⊢ u ≅ u' ∷ U l ^ [ ! , next l ]
          → Γ ⊢ Id (U l) t u ~ Id (U l) t' u' ∷ SProp l' ^ [ ! , next l' ]

    ~-IdUℕ : ∀ {u u' Γ}
           → ⊢ Γ
           → Γ ⊢ u ~ u' ∷ U ⁰ ^ [ ! , next ⁰ ]
           → Γ ⊢ Id (U ⁰) ℕ u ~ Id (U ⁰) ℕ u' ∷ SProp ¹ ^ [ ! , next ¹ ]

    ~-IdUΠ : ∀ {A rA B A' B' u u' Γ} →
          let l = ⁰ in
          let l' = ¹ in
           Γ ⊢ Π A ^ rA ° ⁰ ▹ B ° ⁰ ° ⁰ ≅ Π A' ^ rA ° ⁰ ▹ B' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
           → Γ ⊢ u ~ u' ∷ U l ^ [ ! , next l ]
           → Γ ⊢ Id (U l)  (Π A ^ rA ° l ▹ B ° l ° ⁰ ) u ~ Id (U l) (Π A' ^ rA ° l ▹ B' ° l ° ⁰) u' ∷ SProp l' ^ [ ! , next l' ]

    -- cast congruences

    ~-cast : ∀ {A A' B B' e e' t t' Γ} →
           let l = ⁰ in
             Γ ⊢ A ~ A' ∷ U l ^ [ ! , next l ]
           → Γ ⊢ B ≅ B' ∷ U l ^ [ ! , next l ]
           → Γ ⊢ t ≅ t' ∷ A ^ [ ! , ι l ]
           → Γ ⊢ e ∷ (Id (U ⁰) A B) ^ [ % , next ⁰ ]
           → Γ ⊢ e' ∷ (Id (U ⁰) A' B') ^ [ % , next ⁰ ]
           → Γ ⊢ cast l A B e t ~ cast l A' B' e' t' ∷ B ^ [ ! , ι l ]

    ~-castℕ : ∀ {B B' e e' t t' Γ}
            → ⊢ Γ
            → Γ ⊢ B ~ B' ∷ U ⁰ ^ [ ! , next ⁰ ]
            → Γ ⊢ t ≅ t' ∷ ℕ ^ [ ! , ι ⁰ ]
            → Γ ⊢ e ∷ (Id (U ⁰) ℕ B) ^ [ % , next ⁰ ]
            → Γ ⊢ e' ∷ (Id (U ⁰) ℕ B') ^ [ % , next ⁰ ]
            → Γ ⊢ cast ⁰ ℕ B e t ~ cast ⁰ ℕ B' e' t' ∷ B ^ [ ! , ι ⁰ ]

    ~-castℕℕ : ∀ {e e' t t' Γ}
             → ⊢ Γ
             → Γ ⊢ t ~ t' ∷ ℕ ^ [ ! , ι ⁰ ]
            → Γ ⊢ e ∷ (Id (U ⁰) ℕ ℕ) ^ [ % , next ⁰ ]
            → Γ ⊢ e' ∷ (Id (U ⁰) ℕ ℕ) ^ [ % , next ⁰ ]
             → Γ ⊢ cast ⁰ ℕ ℕ e t ~ cast ⁰ ℕ ℕ e' t' ∷ ℕ ^ [ ! , ι ⁰ ]

    ~-castΠ : ∀ {A A' rA P P' B B' e e' t t' Γ} →
           let l = ⁰ in
           Γ ⊢ Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰ ≅ Π A' ^ rA ° ⁰ ▹ P' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
           → Γ ⊢ B ~ B' ∷ U l ^ [ ! , next l ]
           → Γ ⊢ t ≅ t' ∷ Π A ^ rA ° l ▹ P ° l ° l ^ [ ! , ι l ]
           → Γ ⊢ e ∷ (Id (U ⁰) (Π A ^ rA ° l ▹ P ° l ° l) B) ^ [ % , next ⁰ ]
           → Γ ⊢ e' ∷ (Id (U ⁰) (Π A' ^ rA ° l ▹ P' ° l ° l) B') ^ [ % , next ⁰ ]
           → Γ ⊢ cast l (Π A ^ rA ° l ▹ P ° l ° l) B e t ~ cast l (Π A' ^ rA ° l ▹ P' ° l ° l) B' e' t' ∷ B ^ [ ! , ι l ]

    ~-castℕΠ : ∀ {A A' rA P P' e e' t t' Γ}
             → Γ ⊢ A ∷ Univ rA ⁰ ^ [ ! , next ⁰ ]
             → Γ ∙ A ^ [ rA , ι ⁰ ] ⊢ P ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰ ≅ Π A' ^ rA ° ⁰ ▹ P' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ t ≅ t' ∷ ℕ ^ [ ! , ι ⁰ ]
             → Γ ⊢ e ∷ (Id (U ⁰) ℕ (Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰)) ^ [ % , next ⁰ ]
             → Γ ⊢ e' ∷ (Id (U ⁰) ℕ (Π A' ^ rA ° ⁰ ▹ P' ° ⁰ ° ⁰)) ^ [ % , next ⁰ ]
             → Γ ⊢ cast ⁰ ℕ (Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰) e t ~ cast ⁰ ℕ (Π A' ^ rA ° ⁰ ▹ P' ° ⁰ ° ⁰) e' t' ∷ (Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ]

    ~-castΠℕ : ∀ {A A' rA P P' e e' t t' Γ} →
             let l = ⁰ in
               Γ ⊢ A ∷ Univ rA l ^ [ ! , next l ]
             → Γ ∙ A ^ [ rA , ι l ] ⊢ P ∷ U l ^ [ ! , next l ]
             → Γ ⊢ Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰ ≅ Π A' ^ rA ° ⁰ ▹ P' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ t ≅ t' ∷ (Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰) ^ [ ! , ι l ]
             → Γ ⊢ e ∷ (Id (U ⁰) (Π A ^ rA ° l ▹ P ° l ° ⁰) ℕ) ^ [ % , next ⁰ ]
             → Γ ⊢ e' ∷ (Id (U ⁰) (Π A' ^ rA ° l ▹ P' ° l  ° ⁰) ℕ) ^ [ % , next ⁰ ]
             → Γ ⊢ cast l (Π A ^ rA ° ⁰ ▹ P ° ⁰ ° ⁰) ℕ e t ~ cast l (Π A' ^ rA ° ⁰ ▹ P' ° ⁰ ° ⁰) ℕ e' t' ∷ ℕ ^ [ ! , ι ⁰ ]

    ~-castΠΠ%! : ∀ {A A' P P' B B' Q Q' e e' t t' Γ}
             → Γ ⊢ A ∷ Univ % ⁰ ^ [ ! , next ⁰ ]
             → Γ ∙ A ^ [ % , ι ⁰ ] ⊢ P ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ Π A ^ % ° ⁰ ▹ P ° ⁰  ° ⁰ ≅ Π A' ^ % ° ⁰ ▹ P' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ B ∷ Univ ! ⁰ ^ [ ! , next ⁰ ]
             → Γ ∙ B ^ [ ! , ι ⁰ ] ⊢ Q ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ Π B ^ ! ° ⁰ ▹ Q ° ⁰ ° ⁰ ≅ Π B' ^ ! ° ⁰ ▹ Q' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ t ≅ t' ∷ Π A ^ % ° ⁰ ▹ P ° ⁰  ° ⁰ ^ [ ! , ι ⁰ ]
             → Γ ⊢ e ∷ (Id (U ⁰) (Π A ^ % ° ⁰ ▹ P ° ⁰ ° ⁰) (Π B ^ ! ° ⁰ ▹ Q ° ⁰ ° ⁰)) ^ [ % , next ⁰ ]
             → Γ ⊢ e' ∷ (Id (U ⁰) (Π A' ^ % ° ⁰ ▹ P' ° ⁰ ° ⁰) (Π B' ^ ! ° ⁰ ▹ Q' ° ⁰ ° ⁰)) ^ [ % , next ⁰ ]
             → Γ ⊢ cast ⁰ (Π A ^ % ° ⁰ ▹ P ° ⁰ ° ⁰) (Π B ^ ! ° ⁰ ▹ Q ° ⁰ ° ⁰) e t ~ cast ⁰ (Π A' ^ % ° ⁰ ▹ P' ° ⁰ ° ⁰) (Π B' ^ ! ° ⁰ ▹ Q' ° ⁰ ° ⁰) e' t' ∷ Π B ^ ! ° ⁰ ▹ Q ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ]

    ~-castΠΠ!% : ∀ {A A' P P' B B' Q Q' e e' t t' Γ}
             → Γ ⊢ A ∷ Univ ! ⁰ ^ [ ! , next ⁰ ]
             → Γ ∙ A ^ [ ! , ι ⁰ ] ⊢ P ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ Π A ^ ! ° ⁰ ▹ P ° ⁰ ° ⁰ ≅ Π A' ^ ! ° ⁰ ▹ P' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ B ∷ Univ % ⁰ ^ [ ! , next ⁰ ]
             → Γ ∙ B ^ [ % , ι ⁰ ] ⊢ Q ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ Π B ^ % ° ⁰ ▹ Q ° ⁰ ° ⁰ ≅ Π B' ^ % ° ⁰ ▹ Q' ° ⁰ ° ⁰ ∷ U ⁰ ^ [ ! , next ⁰ ]
             → Γ ⊢ t ≅ t' ∷ Π A ^ ! ° ⁰ ▹ P ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ]
             → Γ ⊢ e ∷ (Id (U ⁰) (Π A ^ ! ° ⁰ ▹ P ° ⁰ ° ⁰) (Π B ^ % ° ⁰ ▹ Q ° ⁰ ° ⁰)) ^ [ % , next ⁰ ]
             → Γ ⊢ e' ∷ (Id (U ⁰) (Π A' ^ ! ° ⁰ ▹ P' ° ⁰ ° ⁰) (Π B' ^ % ° ⁰ ▹ Q' ° ⁰ ° ⁰)) ^ [ % , next ⁰ ]
             → Γ ⊢ cast ⁰ (Π A ^ ! ° ⁰ ▹ P ° ⁰ ° ⁰) (Π B ^ % ° ⁰ ▹ Q ° ⁰ ° ⁰) e t ~ cast ⁰ (Π A' ^ ! ° ⁰ ▹ P' ° ⁰ ° ⁰) (Π B' ^ % ° ⁰ ▹ Q' ° ⁰ ° ⁰) e' t' ∷ Π B ^ % ° ⁰ ▹ Q ° ⁰  ° ⁰ ^ [ ! , ι ⁰ ]

    ~-irrelevance : ∀ {n n′ A l Γ} → Γ ⊢ n ∷ A ^ [ % , l ] → Γ ⊢ n′ ∷ A ^ [ % , l ]
                  → Γ ⊢ n ~ n′ ∷ A ^ [ % , l ]

  -- Composition of universe and generic equality compatibility
  ~-to-≅ : ∀ {t u r l Γ} → Γ ⊢ t ~ u ∷ (Univ r l) ^ [ ! , next l ] → Γ ⊢ t ≅ u ^ [ r , ι l ]
  ~-to-≅ t~u = ≅-univ (~-to-≅ₜ t~u)


-- Andreas, 2017-01-12, issue #2386

postulate
  A : Set

-- Should be rejected:
data Eq : (B : Set) (x y : B) → Set where
  refl : (x : A) → Eq A x x

{-# BUILTIN EQUALITY Eq #-}

-- Expected error:
-- Wrong type of constructor of BUILTIN EQUALITY
-- when checking the pragma BUILTIN EQUALITY Eq


{- Byzantine Fault Tolerant Consensus Verification in Agda, version 0.9.

   Copyright (c) 2021, Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}
open import LibraBFT.Prelude
open import LibraBFT.Abstract.Types.EpochConfig
open        WithAbsVote

-- This module provides a convenient way for modules in other namespaces to import
-- everything from Abstract.

module LibraBFT.Abstract.Abstract
  (UID    : Set)
  (_≟UID_ : (u₀ u₁ : UID) → Dec (u₀ ≡ u₁))
  (NodeId : Set)
  (𝓔  : EpochConfig UID NodeId)
  (𝓥  : VoteEvidence UID NodeId 𝓔)
  where
    open import LibraBFT.Abstract.Types                   UID        NodeId 𝓔    public
    open import LibraBFT.Abstract.RecordChain             UID _≟UID_ NodeId 𝓔 𝓥 public
    open import LibraBFT.Abstract.RecordChain.Assumptions UID _≟UID_ NodeId 𝓔 𝓥 public
    open import LibraBFT.Abstract.Records                 UID _≟UID_ NodeId 𝓔 𝓥 public
    open import LibraBFT.Abstract.Records.Extends         UID _≟UID_ NodeId 𝓔 𝓥 public
    open import LibraBFT.Abstract.Properties              UID _≟UID_ NodeId 𝓔 𝓥 public
    open import LibraBFT.Abstract.System                  UID _≟UID_ NodeId 𝓔 𝓥 public