aoc2023/lib/maybe.quox
2023-12-01 18:52:23 +01:00

140 lines
4 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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