Agda：次要分类的等价关系

Question

我想在CoList (Maybe Nat)上定义一个仅考虑just的平等。当然，我不能只从CoList (Maybe A)转到CoList A，因为这不一定有效。

那么，我的问题是，我如何定义这样的等价关系（不关注可决定性）？如果我可以将无限just个尾部视为非等价的，它会有帮助吗？

下面的@gallais建议我应该能够天真地定义这种关系：

open import Data.Colist
open import Data.Maybe
open import Coinduction
open import Relation.Binary

module _ where
  infix 4 _∼_

  data _∼_ {A : Set} : Colist (Maybe A) → Colist (Maybe A) → Set where
    end : [] ∼ []
    nothingˡ : ∀ {xs ys} → ∞ (♭ xs ∼ ys) → nothing ∷ xs ∼ ys
    nothingʳ : ∀ {xs ys} → ∞ (xs ∼ ♭ ys) → xs ∼ nothing ∷ ys
    justs : ∀ {x xs ys} → ∞ (♭ xs ∼ ♭ ys) → just x ∷ xs ∼ just x ∷ ys

但证明它的传递性从终止检查器中进入（预期）问题：

  refl : ∀ {A} → Reflexive (_∼_ {A})
  refl {A} {[]} = end
  refl {A} {just x ∷ xs} = justs (♯ refl)
  refl {A} {nothing ∷ xs} = nothingˡ (♯ nothingʳ (♯ refl)) -- note how I could have defined this the other way round as well...

  drop-nothingˡ : ∀ {A xs} {ys : Colist (Maybe A)} → nothing ∷ xs ∼ ys → ♭ xs ∼ ys
  drop-nothingˡ (nothingˡ x) = ♭ x
  drop-nothingˡ (nothingʳ x) = nothingʳ (♯ drop-nothingˡ (♭ x))

  trans : ∀ {A} → Transitive (_∼_ {A})
  trans end end = end
  trans end (nothingʳ e2) = nothingʳ e2
  trans (nothingˡ e1) e2 = nothingˡ (♯ trans (♭ e1) e2)
  trans (nothingʳ e1) (nothingˡ e2) = trans (♭ e1) (♭ e2) -- This is where the problem is
  trans (nothingʳ e1) (nothingʳ e2) = nothingʳ (♯ trans (♭ e1) (drop-nothingˡ (♭ e2)))
  trans (justs e1) (nothingʳ e2) = nothingʳ (♯ trans (justs e1) (♭ e2))
  trans (justs e1) (justs e2) = justs (♯ (trans (♭ e1) (♭ e2)))

所以我尝试了双方nothing不那么含糊的情况（比如@Vitus建议的那样）：

module _ where
  infix 4 _∼_

  data _∼_ {A : Set} : Colist (Maybe A) → Colist (Maybe A) → Set where
    end : [] ∼ []
    nothings : ∀ {xs ys} → ∞ (♭ xs ∼ ♭ ys) → nothing ∷ xs ∼ nothing ∷ ys
    nothingˡ : ∀ {xs y ys} → ∞ (♭ xs ∼ just y ∷ ys) → nothing ∷ xs ∼ just y ∷ ys
    nothingʳ : ∀ {x xs ys} → ∞ (just x ∷ xs ∼ ♭ ys) → just x ∷ xs ∼ nothing ∷ ys
    justs : ∀ {x xs ys} → ∞ (♭ xs ∼ ♭ ys) → just x ∷ xs ∼ just x ∷ ys

  refl : ∀ {A} → Reflexive (_∼_ {A})
  refl {A} {[]} = end
  refl {A} {just x ∷ xs} = justs (♯ refl)
  refl {A} {nothing ∷ xs} = nothings (♯ refl)

  sym : ∀ {A} → Symmetric (_∼_ {A})
  sym end = end
  sym (nothings xs∼ys) = nothings (♯ sym (♭ xs∼ys))
  sym (nothingˡ xs∼ys) = nothingʳ (♯ sym (♭ xs∼ys))
  sym (nothingʳ xs∼ys) = nothingˡ (♯ sym (♭ xs∼ys))
  sym (justs xs∼ys) = justs (♯ sym (♭ xs∼ys))

  trans : ∀ {A} → Transitive (_∼_ {A})
  trans end ys∼zs = ys∼zs
  trans (nothings xs∼ys) (nothings ys∼zs) = nothings (♯ trans (♭ xs∼ys) (♭ ys∼zs))
  trans (nothings xs∼ys) (nothingˡ ys∼zs) = nothingˡ (♯ trans (♭ xs∼ys) (♭ ys∼zs))
  trans (nothingˡ xs∼ys) (nothingʳ ys∼zs) = nothings (♯ trans (♭ xs∼ys) (♭ ys∼zs))
  trans (nothingˡ xs∼ys) (justs ys∼zs) = nothingˡ (♯ trans (♭ xs∼ys) (justs ys∼zs))
  trans (nothingʳ xs∼ys) (nothings ys∼zs) = nothingʳ (♯ trans (♭ xs∼ys) (♭ ys∼zs))
  trans {A} {just x ∷ xs} {nothing ∷ ys} {just z ∷ zs} (nothingʳ xs∼ys) (nothingˡ ys∼zs) = ?
  trans (justs xs∼ys) (nothingʳ ys∼zs) = nothingʳ (♯ trans (justs xs∼ys) (♭ ys∼zs))
  trans (justs xs∼ys) (justs ys∼zs) = justs (♯ trans (♭ xs∼ys) (♭ ys∼zs))

但现在我不知道如何定义trans（我留下一个洞的那个）的问题案例

Answer 1

在问题的评论部分经过深思熟虑和垃圾邮件（并拖延将我的本地Agda更新为具有真正终止检查程序的版本）之后，我想出了这个：

module Subcolist where

open import Data.Colist
open import Data.Maybe
open import Coinduction
open import Relation.Binary

module _ {a} {A : Set a} where
  infix 4 _∼_

  data _∼_ : Colist (Maybe A) → Colist (Maybe A) → Set a where
    end      : [] ∼ []
    nothings : ∀ {  xs ys} (r : ∞ (♭ xs ∼ ♭ ys)) → nothing ∷ xs ∼ nothing ∷ ys
    nothingˡ : ∀ {  xs ys} (r :   (♭ xs ∼   ys)) → nothing ∷ xs ∼           ys
    nothingʳ : ∀ {  xs ys} (r :   (  xs ∼ ♭ ys)) →           xs ∼ nothing ∷ ys
    justs    : ∀ {x xs ys} (r : ∞ (♭ xs ∼ ♭ ys)) → just x  ∷ xs ∼ just x  ∷ ys


  refl : Reflexive _∼_
  refl {[]} = end
  refl {just x ∷ xs} = justs (♯ refl)
  refl {nothing ∷ xs} = nothings (♯ refl)

  sym : Symmetric _∼_
  sym end = end
  sym (nothings xs∼ys) = nothings (♯ sym (♭ xs∼ys))
  sym (nothingˡ xs∼ys) = nothingʳ   (sym   xs∼ys)
  sym (nothingʳ xs∼ys) = nothingˡ   (sym   xs∼ys)
  sym (justs    xs∼ys) = justs    (♯ sym (♭ xs∼ys))

  drop-nothingˡ : ∀ {xs} {ys : Colist (Maybe A)} → nothing ∷ xs ∼ ys → ♭ xs ∼ ys
  drop-nothingˡ (nothings r) = nothingʳ (♭ r)
  drop-nothingˡ (nothingˡ r) = r
  drop-nothingˡ (nothingʳ r) = nothingʳ (drop-nothingˡ r)

  drop-nothingʳ : ∀ {xs : Colist (Maybe A)} {ys} → xs ∼ nothing ∷ ys → xs ∼ ♭ ys
  drop-nothingʳ (nothings r) = nothingˡ (♭ r)
  drop-nothingʳ (nothingˡ r) = nothingˡ (drop-nothingʳ r)
  drop-nothingʳ (nothingʳ r) = r

  drop-nothings : ∀ {xs ys : ∞ (Colist (Maybe A))} → nothing ∷ xs ∼ nothing ∷ ys → ♭ xs ∼ ♭ ys
  drop-nothings (nothings r) = ♭ r
  drop-nothings (nothingˡ r) = drop-nothingʳ r
  drop-nothings (nothingʳ r) = drop-nothingˡ r

  []-trans : ∀ {xs ys : Colist (Maybe A)} → xs ∼ ys → ys ∼ [] → xs ∼ []
  []-trans xs∼ys end = xs∼ys
  []-trans xs∼ys (nothingˡ ys∼[]) = []-trans (drop-nothingʳ xs∼ys) ys∼[]

  mutual    
    just-trans : ∀ {xs ys zs} {z : A} → xs ∼ ys → ys ∼ just z ∷ zs → xs ∼ just z ∷ zs
    just-trans (justs r) (justs r₁) = justs (♯ (trans (♭ r) (♭ r₁)))
    just-trans (nothingˡ xs∼ys) ys∼zs = nothingˡ (just-trans xs∼ys ys∼zs)
    just-trans xs∼ys (nothingˡ ys∼zs) = just-trans (drop-nothingʳ xs∼ys) ys∼zs

    nothing-trans : ∀ {xs ys : Colist (Maybe A)} {zs} → xs ∼ ys → ys ∼ nothing ∷ zs → xs ∼ nothing ∷ zs
    nothing-trans (nothings xs∼ys) ys∼zs = nothings (♯ trans (♭ xs∼ys) (drop-nothings ys∼zs))
    nothing-trans (nothingˡ xs∼ys) ys∼zs = nothings (♯ (trans xs∼ys (drop-nothingʳ ys∼zs)))
    nothing-trans (nothingʳ xs∼ys) ys∼zs = nothing-trans xs∼ys (drop-nothingˡ ys∼zs)
    nothing-trans {xs = just x  ∷ xs} xs∼ys (nothingʳ ys∼zs) = nothingʳ (trans xs∼ys ys∼zs)
    nothing-trans end xs∼ys = xs∼ys

    trans : Transitive _∼_
    trans {k = []}           xs∼ys ys∼zs = []-trans      xs∼ys ys∼zs
    trans {k = nothing ∷ ks} xs∼ys ys∼zs = nothing-trans xs∼ys ys∼zs
    trans {k = just k  ∷ ks} xs∼ys ys∼zs = just-trans    xs∼ys ys∼zs

  equivalence : Setoid a a
  equivalence = record 
    { _≈_ = _∼_
    ; isEquivalence = record 
      { refl  = refl
      ; sym   = sym
      ; trans = trans
      }
    }

我使用混合感应 - 诱导，我相信它捕获了你想要的概念。由于trans的幼稚版本没有通过它，我需要跳过一些箍来通过终止/生产力检查，但这似乎有效。它的部分启发来自于我从Nils Anders Danielsson的偏爱monad的实现中学到的东西，它在那里有类似的关系定义。它并不像这个复杂，但让Agda接受它的工作大致相似。为了略微概括，将它视为一个三角形变换器似乎更友好，而不仅仅假设justs情况的定义/命题相等，但这是一个微不足道的变化。

我确实注意到其他两个提案违反nothing ∷ nothing ∷ [] ∼ []这似乎与原始问题相反，所以我编辑了类型以再次支持它。我认为这样做会阻止_∼_独特的居住，但是修复它可能会导致关系类型中有更多的构造函数，这比看起来更有价值。

值得注意的是，在我写这篇文章的时候，Agda在其终止检查程序中有一个适用于我的版本的漏洞（＃787）。我不确定是什么导致了这个错误所以我无法保证我的版本完全合理，但这对我来说很有意义。

Answer 2

为了尝试不同的方法，我决定使用列表语义的数据类型：

data Sem (A : Set) : Set where
  [] : Sem A
  ⊥ : Sem A
  _∷_ : A → ∞ (Sem A) → Sem A

以及列表与其语义之间不可判的二元关系：

data _HasSem_ {A : Set} : Colist (Maybe A) → Sem A → Set where
  [] : [] HasSem []
  ⊥ : ∀ {l} → ∞ (♭ l HasSem ⊥) → (nothing ∷ l) HasSem ⊥
  n∷_ : ∀ {l s} → ♭ l HasSem s → (nothing ∷ l) HasSem s
  _∷_ : ∀ {l s} x → ∞ (♭ l HasSem ♭ s) → (just x ∷ l) HasSem (x ∷ s)

然后，列表相等的定义直到语义很容易：

a ≈ b = ∀ s → a HasSem s → b HasSem s

isEquivalence当然是微不足道的，除了sym，它看起来你需要使双向箭头（一个HasSem s⇔b HasSem s）来建设性地证明。

然后我试图证明我的平等概念等同于copumpkin，我遇到了一些麻烦。我能够建设性地证明一个方向：

from : ∀ {a b} → a ∼ b → a ≈ b

然而，在排除排除中间后，我只能朝另一个方向前进：

LEM = (A : Set) → Dec A
to : LEM → ∀ {a b} → a ≈ b → a ∼ b

我无法证明to更好的非建设性版本：

nicer-to : ∀ {a b} → a ≈ b → ¬ ¬ a ∼ b -- Not proven

完整的代码如下。还有一些其他属性的证明，例如假设LEM的存在证明和语义的唯一性。

module colists where

open import Coinduction
open import Data.Colist hiding (_≈_)

data Sem (A : Set) : Set where
  [] : Sem A
  ⊥ : Sem A
  _∷_ : A → ∞ (Sem A) → Sem A

open import Data.Maybe

data _HasSem_ {A : Set} : Colist (Maybe A) → Sem A → Set where
  [] : [] HasSem []
  ⊥ : ∀ {l} → ∞ (♭ l HasSem ⊥) → (nothing ∷ l) HasSem ⊥
  n∷_ : ∀ {l s} → ♭ l HasSem s → (nothing ∷ l) HasSem s
  _∷_ : ∀ {l s} x → ∞ (♭ l HasSem ♭ s) → (just x ∷ l) HasSem (x ∷ s)

open import Function.Equivalence

_≈_ : ∀ {A : Set} → Colist (Maybe A) → Colist (Maybe A) → Set
a ≈ b = ∀ s → a HasSem s → b HasSem s

data _∼_  {A : Set} : Colist (Maybe A) → Colist (Maybe A) → Set where
    end      : [] ∼ []
    nothings : ∀ {  xs ys} (r : ∞ (♭ xs ∼ ♭ ys)) → (nothing ∷ xs) ∼ (nothing ∷ ys)
    nothingˡ : ∀ {  xs ys} (r :   (♭ xs ∼   ys)) → (nothing ∷ xs) ∼           ys
    nothingʳ : ∀ {  xs ys} (r :   (  xs ∼ ♭ ys)) →           xs ∼ (nothing ∷ ys)
    justs    : ∀ {x xs ys} (r : ∞ (♭ xs ∼ ♭ ys)) → (just x  ∷ xs) ∼ (just x  ∷ ys)

module WithA (A : Set) where

  CLMA = Colist (Maybe A)

  from-[] : ∀ {a b : CLMA} → a ∼ b → a HasSem [] → b HasSem []
  from-[] end [] = []
  from-[] (nothingʳ r) a-has = n∷ (from-[] r a-has)
  from-[] (nothings r) (n∷ y) = n∷ (from-[] (♭ r) y)
  from-[] (nothingˡ r) (n∷ y) = from-[] r y
  from-[] (justs _) ()

  from-⊥ : ∀ {a b : CLMA} → a ∼ b → a HasSem ⊥ → b HasSem ⊥
  from-⊥ (nothings r) (⊥ y) = ⊥ (♯ (from-⊥ (♭ r) (♭ y)))
  from-⊥ (nothingˡ r) (⊥ y) = from-⊥ r (♭ y)
  from-⊥ (nothingʳ r) (⊥ y) = ⊥ (♯ (from-⊥ r (⊥ y)))
  from-⊥ (nothings r) (n∷ y) = ⊥ (♯ (from-⊥ (♭ r) y))
  from-⊥ (nothingˡ r) (n∷ y) = from-⊥ r y
  from-⊥ (nothingʳ r) (n∷ y) = ⊥ (♯ (from-⊥ r (⊥ (♯ y))))
  from-⊥ (justs _) ()
  from-⊥ end ()

  from' : ∀ {a b : CLMA} {s} → a ∼ b → a HasSem s → b HasSem s
  from-∷ : ∀ {a b : CLMA} {x s} → a ∼ b → a HasSem (x ∷ s) → b HasSem (x ∷ s)
  from' {a} {b} {[]} eq sem = from-[] eq sem
  from' {a} {b} {⊥} eq sem = from-⊥ eq sem
  from' {a} {b} {y ∷ y'} eq sem = from-∷ eq sem

  from-∷ (nothings r) (n∷ y) = n∷ from-∷ (♭ r) y
  from-∷ (nothingˡ r) (n∷ y) = from-∷ r y
  from-∷ (nothingʳ r) (n∷ y) = n∷ from-∷ r (n∷ y)
  from-∷ (nothingʳ r) (x ∷ y) = n∷ (from-∷ r (x ∷ y))
  from-∷ (justs r) (x ∷ y) = x ∷ ♯ from' (♭ r) (♭ y)
  from-∷ end ()

  from : ∀ {a b : CLMA} → a ∼ b → a ≈ b
  from eq sem has = from' eq has

  refl : ∀ (a : CLMA) → a ≈ a
  refl a = λ s z → z

  trans : ∀ (a b c : CLMA) → a ≈ b → b ≈ c → a ≈ c
  trans a b c ab bc s as = bc s (ab s as)

  open import Relation.Nullary
  open import Data.Product

  data AllNothing : CLMA → Set where
   allNothing : ∀ {l} → ∞ (AllNothing (♭ l)) → AllNothing (nothing ∷ l)
   [] : AllNothing []

  data HasJust : CLMA → Set where
   just : ∀ x l → HasJust (just x ∷ l)
   nothing : ∀ l → HasJust (♭ l) → HasJust (nothing ∷ l)

  import Data.Empty

  notSomeMeansAll : ∀ {x} → ¬ HasJust x → AllNothing x
  notSomeMeansAll {[]} ns = []
  notSomeMeansAll {just x ∷ xs} ns with ns (just x xs)
  ... | ()
  notSomeMeansAll {nothing ∷ xs} ns = allNothing {xs} ( ♯ notSomeMeansAll {♭ xs} (λ z → ns (nothing xs z)) )

  data HasBot : CLMA → Set where
    ⊥ : ∀ l → ∞ (HasBot (♭ l)) → HasBot (nothing ∷ l)
    _∷_ : ∀ x l → HasBot (♭ l) → HasBot (x ∷ l)

  data IsBot : CLMA → Set where
    ⊥ : ∀ {l} → ∞ (IsBot (♭ l)) → IsBot (nothing ∷ l)

  data IsEmpty : CLMA → Set where
    [] : IsEmpty []
    n∷_ : ∀ {l} → IsEmpty (♭ l) → IsEmpty (nothing ∷ l)

  getAfterJust : {a : CLMA} → HasJust a → A × CLMA
  getAfterJust (just x l) = x , ♭ l
  getAfterJust (nothing l y) = getAfterJust y

  data SemStream : Colist (Maybe A) → Set where
    [] : ∀ {l} → IsEmpty l → SemStream l
    ⊥ : ∀ {l} → IsBot l → SemStream l
    _∷_ : ∀ {l} → (hj : HasJust l) → ∞ (SemStream (proj₂ (getAfterJust hj))) → SemStream l

  getSem : ∀ {a} → SemStream a → Sem A
  go : ∀ {a} → SemStream a → ∞ (Sem A)
  go rec = ♯ getSem rec
  getSem ([] _) = []
  getSem (⊥ _) = ⊥
  getSem {a} (hj ∷ rec) = proj₁ (getAfterJust hj) ∷ go (♭ rec)

  getSem-empty-good : ∀ {a} → IsEmpty a → a HasSem []
  getSem-empty-good [] = []
  getSem-empty-good (n∷ y) = n∷ getSem-empty-good y

  getSem-good : ∀ {a} (s : SemStream a) → a HasSem getSem s
  getSem-good ([] emp) = getSem-empty-good emp
  getSem-good (⊥ (⊥ y)) = ⊥ (♯ getSem-good (⊥ (♭ y)))
  getSem-good (just x l ∷ y) = x ∷ (♯ getSem-good (♭ y))
  getSem-good (nothing l y ∷ y') = n∷ getSem-good (y ∷ y')

  allNothing-variants' : ∀ {a} → ¬ IsEmpty a → AllNothing a → IsBot a
  allNothing-variants' nie (allNothing y) = ⊥ (♯  allNothing-variants' (λ z → nie (n∷ z)) (♭ y))
  allNothing-variants' nie [] with nie []
  ... | ()

  open import Data.Sum

  module WithEM (EM : (A : Set) → Dec A) where

    allNothing-variants : ∀ {a} → AllNothing a → IsEmpty a ⊎ IsBot a
    allNothing-variants {a} an with EM (IsEmpty a)
    ... | yes ie = inj₁ ie
    ... | no nie = inj₂ (allNothing-variants' nie an)

    mustbe : ∀ (a : CLMA) → SemStream a
    mustbe a with EM (HasJust a)
    mustbe a | yes p = p ∷ (♯ mustbe _)
    mustbe a | no ¬p with notSomeMeansAll ¬p
    ... | all with allNothing-variants all
    ... | inj₁ x = [] x
    ... | inj₂ y = ⊥ y

    mustbe' : ∀ (a : CLMA) → ∃ (λ s → a HasSem s)
    mustbe' a = getSem (mustbe a) , getSem-good (mustbe a)

    data Sem-Eq : Sem A → Sem A → Set where
      [] : Sem-Eq [] []
      ⊥ : Sem-Eq ⊥ ⊥
      _∷_ : ∀ x {a b} → ∞ (Sem-Eq (♭ a) (♭ b)) → Sem-Eq (x ∷ a) (x ∷ b)

    sem-unique⊥ : ∀ {x b} → x HasSem ⊥ → x HasSem b → Sem-Eq ⊥ b
    sem-unique⊥ () []
    sem-unique⊥ s⊥ (⊥ y) = ⊥
    sem-unique⊥ (⊥ y) (n∷ y') = sem-unique⊥ (♭ y) y'
    sem-unique⊥ (n∷ y) (n∷ y') = sem-unique⊥ y y'

    sem-unique' : ∀ {x a b} → x HasSem a → x HasSem b → Sem-Eq a b
    sem-unique' [] [] = []
    sem-unique' (⊥ y) hasb = sem-unique⊥ (⊥ y) hasb
    sem-unique' (n∷ y) (⊥ y') = sem-unique' y (♭ y')
    sem-unique' (n∷ y) (n∷ y') = sem-unique' y y'
    sem-unique' (x ∷ y) (.x ∷ y') = x ∷ (♯ sem-unique' (♭ y) (♭ y'))

    to' : ∀ {a b : Colist (Maybe A)} {s} → a HasSem s → b HasSem s → a ∼ b
    to' [] [] = end
    to' [] (n∷ y) = nothingʳ (to' [] y)
    to' (⊥ y) (⊥ y') = nothings (♯ to' (♭ y) (♭ y'))
    to' (⊥ y) (n∷ y') = nothings (♯ to' (♭ y) y')
    to' (n∷ y) [] = nothingˡ (to' y [])
    to' (n∷ y) (⊥ y') = nothings (♯ to' y (♭ y'))
    to' (n∷ y) (n∷ y') = nothings (♯ to' y y')
    to' (n∷ y) (x ∷ y') = nothingˡ (to' y (x ∷ y'))
    to' (x ∷ y) (n∷ y') = nothingʳ (to' (x ∷ y) y')
    to' (x ∷ y) (.x ∷ y') = justs (♯ to' (♭ y) (♭ y'))

    to : ∀ (a b : Colist (Maybe A)) → a ≈ b → a ∼ b
    to a b eq with mustbe' a
    ... | s , a-s with eq s a-s
    ... | b-s = to' a-s b-s

    hasSem-respects : ∀ {x s1 s2} → x HasSem s1 → Sem-Eq s1 s2 → x HasSem s2
    hasSem-respects [] [] = []
    hasSem-respects (⊥ y) ⊥ = ⊥ y
    hasSem-respects (n∷ y) eq = n∷ hasSem-respects y eq
    hasSem-respects (x ∷ y) (.x ∷ y') = x ∷ ♯ hasSem-respects (♭ y) (♭ y')

    sym' : ∀ (a b : CLMA) → a ≈ b → b ≈ a
    sym' a b eq s b-s with mustbe' a
    ... | s' , a-s' = hasSem-respects a-s' (sem-unique' (eq s' a-s') b-s)

Answer 3

写下您想要的同情关系！

module colist where

open import Coinduction
open import Data.Maybe

data CoList (A : Set) : Set where
  ■ : CoList A
  _∷_ : A → ∞ (CoList A) → CoList A

data EqCoList {A : Set} : CoList (Maybe A) → CoList (Maybe A) → Set where
-- two empty lists are equal
  conil : EqCoList ■ ■
-- nothings do not matter equality-wise
  nonel : ∀ xs ys → ∞ (EqCoList (♭ xs) ys) → EqCoList (nothing ∷ xs) ys
  noner : ∀ xs ys → ∞ (EqCoList xs (♭ ys)) → EqCoList xs (nothing ∷ ys)
-- justs have to agree
  justs : ∀ x xs ys → ∞ (EqCoList (♭ xs) (♭ ys)) → EqCoList (just x ∷ xs) (just x ∷ ys)