117 lines
3.3 KiB
Plaintext
117 lines
3.3 KiB
Plaintext
|
load "misc.quox"
|
|||
|
|
load "bool.quox"
|
|||
|
|
|
|||
|
|
namespace either {
|
|||
|
|
|
|||
|
|
def0 Tag : ★ = {left, right}
|
|||
|
|
|
|||
|
|
def0 Payload : ★ → ★ → Tag → ★ =
|
|||
|
|
λ A B tag ⇒ case tag return ★ of { 'left ⇒ A; 'right ⇒ B }
|
|||
|
|
|
|||
|
|
def0 Either : ★ → ★ → ★ =
|
|||
|
|
λ A B ⇒ (tag : Tag) × Payload A B tag
|
|||
|
|
|
|||
|
|
def Left : 0.(A B : ★) → A → Either A B =
|
|||
|
|
λ A B x ⇒ ('left, x)
|
|||
|
|
|
|||
|
|
def Right : 0.(A B : ★) → B → Either A B =
|
|||
|
|
λ A B x ⇒ ('right, x)
|
|||
|
|
|
|||
|
|
def elim :
|
|||
|
|
0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
|
|||
|
|
ω.((x : A) → P (Left A B x)) →
|
|||
|
|
ω.((x : B) → P (Right A B x)) →
|
|||
|
|
(x : Either A B) → P x =
|
|||
|
|
λ A B P f g e ⇒
|
|||
|
|
case e return e' ⇒ P e' of { (t, a) ⇒
|
|||
|
|
case t return t' ⇒ (a : Payload A B t') → P (t', a)
|
|||
|
|
of { 'left ⇒ f; 'right ⇒ g } a
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
def elimω :
|
|||
|
|
0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
|
|||
|
|
ω.(ω.(x : A) → P (Left A B x)) →
|
|||
|
|
ω.(ω.(x : B) → P (Right A B x)) →
|
|||
|
|
ω.(x : Either A B) → P x =
|
|||
|
|
λ A B P f g e ⇒
|
|||
|
|
case fst e return t' ⇒ ω.(a : Payload A B t') → P (t', a)
|
|||
|
|
of { 'left ⇒ f; 'right ⇒ g } (snd e)
|
|||
|
|
|
|||
|
|
def fold :
|
|||
|
|
0.(A B C : ★) → ω.(A → C) → ω.(B → C) → Either A B → C =
|
|||
|
|
λ A B C ⇒ elim A B (λ _ ⇒ C)
|
|||
|
|
|
|||
|
|
def foldω :
|
|||
|
|
0.(A B C : ★) → ω.(ω.A → C) → ω.(ω.B → C) → ω.(Either A B) → C =
|
|||
|
|
λ A B C ⇒ elimω A B (λ _ ⇒ C)
|
|||
|
|
|
|||
|
|
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
def0 Either = either.Either
|
|||
|
|
def Left = either.Left
|
|||
|
|
def Right = either.Right
|
|||
|
|
|
|||
|
|
|
|||
|
|
namespace dec {
|
|||
|
|
|
|||
|
|
def0 Dec : ★ → ★ = λ A ⇒ Either [0.A] [0.Not A]
|
|||
|
|
|
|||
|
|
def Yes : 0.(A : ★) → 0.A → Dec A = λ A y ⇒ Left [0.A] [0.Not A] [y]
|
|||
|
|
def No : 0.(A : ★) → 0.(Not A) → Dec A = λ A n ⇒ Right [0.A] [0.Not A] [n]
|
|||
|
|
|
|||
|
|
def yes-refl : 0.(A : ★) → 0.(x : A) → Dec (x ≡ x : A) =
|
|||
|
|
λ A x ⇒ Yes (x ≡ x : A) (δ 𝑖 ⇒ x)
|
|||
|
|
|
|||
|
|
def0 DecEq : ★ → ★ =
|
|||
|
|
λ A ⇒ ω.(x y : A) → Dec (x ≡ y : A)
|
|||
|
|
|
|||
|
|
def elim :
|
|||
|
|
0.(A : ★) → 0.(P : 0.(Dec A) → ★) →
|
|||
|
|
ω.(0.(y : A) → P (Yes A y)) →
|
|||
|
|
ω.(0.(n : Not A) → P (No A n)) →
|
|||
|
|
(x : Dec A) → P x =
|
|||
|
|
λ A P f g ⇒
|
|||
|
|
either.elim [0.A] [0.Not A] P
|
|||
|
|
(λ y ⇒ case y return y' ⇒ P (Left [0.A] [0.Not A] y') of {[y'] ⇒ f y'})
|
|||
|
|
(λ n ⇒ case n return n' ⇒ P (Right [0.A] [0.Not A] n') of {[n'] ⇒ g n'})
|
|||
|
|
|
|||
|
|
def bool : 0.(A : ★) → Dec A → Bool =
|
|||
|
|
λ A ⇒ elim A (λ _ ⇒ Bool) (λ _ ⇒ 'true) (λ _ ⇒ 'false)
|
|||
|
|
|
|||
|
|
def drop' : 0.(A : ★) → Dec A → True =
|
|||
|
|
λ A ⇒ elim A (λ _ ⇒ True) (λ _ ⇒ 'true) (λ _ ⇒ 'true)
|
|||
|
|
|
|||
|
|
def drop : 0.(A B : ★) → Dec A → B → B =
|
|||
|
|
λ A B x y ⇒ true.drop B (drop' A x) y
|
|||
|
|
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
def0 Dec = dec.Dec
|
|||
|
|
def0 DecEq = dec.DecEq
|
|||
|
|
def Yes = dec.Yes
|
|||
|
|
def No = dec.No
|
|||
|
|
|
|||
|
|
|
|||
|
|
namespace dect {
|
|||
|
|
|
|||
|
|
def0 DecT : ★ → ★ = λ A ⇒ Either A [0.Not A]
|
|||
|
|
|
|||
|
|
def YesT : 0.(A : ★) → 1.A → DecT A = λ A y ⇒ Left A [0.Not A] y
|
|||
|
|
def NoT : 0.(A : ★) → 0.(Not A) → DecT A = λ A n ⇒ Right A [0.Not A] [n]
|
|||
|
|
|
|||
|
|
def elim :
|
|||
|
|
0.(A : ★) → 0.(P : 0.(DecT A) → ★) →
|
|||
|
|
ω.(1.(y : A) → P (YesT A y)) →
|
|||
|
|
ω.(0.(n : Not A) → P (NoT A n)) →
|
|||
|
|
(x : DecT A) → P x =
|
|||
|
|
λ A P f g ⇒
|
|||
|
|
either.elim A [0.Not A] P
|
|||
|
|
f
|
|||
|
|
(λ n ⇒ case n return n' ⇒ P (Right A [0.Not A] n') of {[n'] ⇒ g n'})
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
def0 DecT = dect.DecT
|
|||
|
|
def YesT = dect.YesT
|
|||
|
|
def NoT = dect.NoT
|