140 lines
4 KiB
Text
140 lines
4 KiB
Text
load "misc.quox"
|
||
load "pair.quox"
|
||
load "either.quox"
|
||
|
||
namespace maybe {
|
||
|
||
def0 Tag : ★ = {nothing, just}
|
||
|
||
def0 Payload : Tag → ★ → ★ =
|
||
λ tag A ⇒ case tag return ★ of { 'nothing ⇒ True; 'just ⇒ A }
|
||
|
||
def0 Maybe : ★ → ★ =
|
||
λ A ⇒ (t : Tag) × Payload t A
|
||
|
||
def tag : 0.(A : ★) → ω.(Maybe A) → Tag =
|
||
λ _ x ⇒ caseω x return Tag of { (tag, _) ⇒ tag }
|
||
|
||
def Nothing : 0.(A : ★) → Maybe A =
|
||
λ _ ⇒ ('nothing, 'true)
|
||
|
||
def Just : 0.(A : ★) → A → Maybe A =
|
||
λ _ x ⇒ ('just, x)
|
||
|
||
def0 IsJustTag : Tag → ★ =
|
||
λ t ⇒ case t return ★ of { 'just ⇒ True; 'nothing ⇒ False }
|
||
|
||
def0 IsJust : (A : ★) → Maybe A → ★ =
|
||
λ A x ⇒ IsJustTag (tag A x)
|
||
|
||
def is-just? : 0.(A : ★) → ω.(x : Maybe A) → Dec (IsJust A x) =
|
||
λ A x ⇒
|
||
caseω tag A x return t ⇒ Dec (IsJustTag t) of {
|
||
'just ⇒ Yes True 'true;
|
||
'nothing ⇒ No False (λ x ⇒ x)
|
||
}
|
||
|
||
def0 nothing-unique :
|
||
(A : ★) → (x : True) → ('nothing, x) ≡ Nothing A : Maybe A =
|
||
λ A x ⇒
|
||
case x return x' ⇒ ('nothing, x') ≡ Nothing A : Maybe A of {
|
||
'true ⇒ δ _ ⇒ ('nothing, 'true)
|
||
}
|
||
|
||
def elim' :
|
||
0.(A : ★) →
|
||
0.(P : (t : Tag) → Payload t A → ★) →
|
||
ω.(P 'nothing 'true) →
|
||
ω.((x : A) → P 'just x) →
|
||
(t : Tag) → (x : Payload t A) → P t x =
|
||
λ A P nothing just tag ⇒
|
||
case tag return t ⇒ (x : Payload t A) → P t x of {
|
||
'nothing ⇒ λ x ⇒ case x return x' ⇒ P 'nothing x' of { 'true ⇒ nothing };
|
||
'just ⇒ just
|
||
}
|
||
|
||
def elim :
|
||
0.(A : ★) →
|
||
0.(P : Maybe A → ★) →
|
||
ω.(P (Nothing A)) →
|
||
ω.((x : A) → P (Just A x)) →
|
||
(x : Maybe A) → P x =
|
||
λ A P n j x ⇒
|
||
case x return x' ⇒ P x' of {
|
||
(tag, payload) ⇒ elim' A (λ x t ⇒ P (x, t)) n j tag payload
|
||
}
|
||
|
||
def elimω' :
|
||
0.(A : ★) →
|
||
0.(P : (t : Tag) → Payload t A → ★) →
|
||
ω.(P 'nothing 'true) →
|
||
ω.(ω.(x : A) → P 'just x) →
|
||
ω.(t : Tag) → ω.(x : Payload t A) → P t x =
|
||
λ A P nothing just tag ⇒
|
||
case tag return t ⇒ ω.(x : Payload t A) → P t x of {
|
||
'nothing ⇒ λ x ⇒ case x return x' ⇒ P 'nothing x' of { 'true ⇒ nothing };
|
||
'just ⇒ just
|
||
}
|
||
|
||
def elimω :
|
||
0.(A : ★) →
|
||
0.(P : Maybe A → ★) →
|
||
ω.(P (Nothing A)) →
|
||
ω.(ω.(x : A) → P (Just A x)) →
|
||
ω.(x : Maybe A) → P x =
|
||
λ A P n j x ⇒
|
||
caseω x return x' ⇒ P x' of {
|
||
(tag, payload) ⇒ elimω' A (λ x t ⇒ P (x, t)) n j tag payload
|
||
}
|
||
|
||
{-
|
||
-- direct elim implementation
|
||
def elim :
|
||
0.(A : ★) →
|
||
0.(P : Maybe A → ★) →
|
||
ω.(P (Nothing A)) →
|
||
ω.((x : A) → P (Just A x)) →
|
||
(x : Maybe A) → P x =
|
||
λ A P n j x ⇒
|
||
case x return x' ⇒ P x' of { (tag, payload) ⇒
|
||
(case tag
|
||
return t ⇒
|
||
0.(eq : tag ≡ t : Tag) → P (t, coe (𝑖 ⇒ Payload (eq @𝑖) A) payload)
|
||
of {
|
||
'nothing ⇒
|
||
λ eq ⇒
|
||
case coe (𝑖 ⇒ Payload (eq @𝑖) A) payload
|
||
return p ⇒ P ('nothing, p)
|
||
of { 'true ⇒ n };
|
||
'just ⇒ λ eq ⇒ j (coe (𝑖 ⇒ Payload (eq @𝑖) A) payload)
|
||
}) (δ 𝑖 ⇒ tag)
|
||
}
|
||
-}
|
||
|
||
def fold : 0.(A B : ★) → ω.B → ω.(A → B) → Maybe A → B =
|
||
λ A B ⇒ elim A (λ _ ⇒ B)
|
||
|
||
def foldω : 0.(A B : ★) → ω.B → ω.(ω.A → B) → ω.(Maybe A) → B =
|
||
λ A B ⇒ elimω A (λ _ ⇒ B)
|
||
|
||
def join : 0.(A : ★) → (Maybe (Maybe A)) → Maybe A =
|
||
λ A ⇒ fold (Maybe A) (Maybe A) (Nothing A) (λ x ⇒ x)
|
||
|
||
def pair : 0.(A B : ★) → ω.(Maybe A) → ω.(Maybe B) → Maybe (A × B) =
|
||
λ A B x y ⇒
|
||
foldω A (Maybe (A × B)) (Nothing (A × B))
|
||
(λ x' ⇒ fold B (Maybe (A × B)) (Nothing (A × B))
|
||
(λ y' ⇒ Just (A × B) (x', y')) y) x
|
||
|
||
|
||
def check : 0.(A : ★) → (ω.A → Bool) → ω.A → Maybe A =
|
||
λ A p x ⇒ bool.if (Maybe A) (p x) (Just A x) (Nothing A)
|
||
|
||
def or : 0.(A : ★) → Maybe A → ω.(Maybe A) → Maybe A =
|
||
λ A l r ⇒ fold A (Maybe A) r (Just A) l
|
||
|
||
}
|
||
|
||
def0 Maybe = maybe.Maybe
|
||
def Just = maybe.Just
|
||
def Nothing = maybe.Nothing
|