aoc2023/lib/maybe.quox

147 lines
4.3 KiB
Text
Raw Normal View History

2023-12-01 12:52:23 -05:00
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
2023-12-06 21:47:23 -05:00
def map : 0.(A B : ★) → ω.(A → B) → Maybe A → Maybe B =
λ A B f ⇒ fold A (Maybe B) (Nothing B) (λ x ⇒ Just B (f x))
def mapω : 0.(A B : ★) → ω.(ω.A → B) → ω.(Maybe A) → Maybe B =
λ A B f ⇒ foldω A (Maybe B) (Nothing B) (λ x ⇒ Just B (f x))
2023-12-01 12:52:23 -05:00
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