aoc2023/lib/misc.quox
2023-12-12 20:37:05 +01:00

135 lines
4.3 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.

def0 True : ★ = {true}
namespace true {
def drop : 0.(A : ★) → True → A → A =
λ A t x ⇒ case t return A of { 'true ⇒ x }
}
def0 False : ★ = {}
def0 Not : ★ → ★ = λ A ⇒ ω.A → False
def void : 0.(A : ★) → 0.False → A =
λ A v ⇒ case0 v return A of { }
def0 Iff : ★ → ★ → ★ = λ A B ⇒ (A → B) × (B → A)
def0 All : (A : ★) → (0.A → ★) → ★ =
λ A P ⇒ (x : A) → P x
def0 cong :
(A : ★) → (P : 0.A → ★) → (p : All A P) →
(x y : A) → (xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
λ A P p x y xy ⇒ δ 𝑖 ⇒ p (xy @𝑖)
def0 cong' :
(A B : ★) → (f : A → B) →
(x y : A) → (xy : x ≡ y : A) → f x ≡ f y : B =
λ A B ⇒ cong A (λ _ ⇒ B)
def0 coherence :
(A B : ★) → (AB : A ≡ B : ★) → (x : A) →
Eq (𝑖 ⇒ AB @𝑖) x (coe (𝑖 ⇒ AB @𝑖) x) =
λ A B AB x ⇒
δ 𝑗 ⇒ coe (𝑖 ⇒ AB @𝑖) @0 @𝑗 x
def0 eq-f :
0.(A : ★) → 0.(P : 0.A → ★) →
0.(p : All A P) → 0.(q : All A P) →
0.A → ★ =
λ A P p q x ⇒ p x ≡ q x : P x
def funext :
0.(A : ★) → 0.(P : 0.A → ★) → 0.(p q : All A P) →
(All A (eq-f A P p q)) → p ≡ q : All A P =
λ A P p q eq ⇒ δ 𝑖 ⇒ λ x ⇒ eq x @𝑖
def refl : 0.(A : ★) → (x : A) → x ≡ x : A = λ A x ⇒ δ _ ⇒ x
def sym : 0.(A : ★) → 0.(x y : A) → (x ≡ y : A) → y ≡ x : A =
λ A x y eq ⇒ δ 𝑖 ⇒ comp A (eq @0) @𝑖 { 0 𝑗 ⇒ eq @𝑗; 1 _ ⇒ eq @0 }
def trans : 0.(A : ★) → 0.(x y z : A) →
ω.(x ≡ y : A) → ω.(y ≡ z : A) → x ≡ z : A =
λ A x y z eq1 eq2 ⇒ δ 𝑖
comp A (eq1 @𝑖) @𝑖 { 0 _ ⇒ eq1 @0; 1 𝑗 ⇒ eq2 @𝑗 }
def appω : 0.(A B : ★) → ω.(f : ω.A → B) → [ω.A] → [ω.B] =
λ A B f x ⇒
case x return [ω.B] of { [x'] ⇒ [f x'] }
def app2ω : 0.(A B C : ★) → ω.(f : ω.A → ω.B → C) → [ω.A] → [ω.B] → [ω.C] =
λ A B C f x y ⇒
case x return [ω.C] of { [x'] ⇒
case y return [ω.C] of { [y'] ⇒ [f x' y'] }
}
def getω : 0.(A : ★) → [ω.A] → A =
λ A x ⇒ case x return A of { [x] ⇒ x }
def0 get0 : (A : ★) → [0.A] → A =
λ A x ⇒ case x return A of { [x] ⇒ x }
def drop0 : 0.(A B : ★) → [0.B] → A → A =
λ A B x y ⇒ case x return A of { [_] ⇒ y }
def0 drop0-eq : (A B : ★) → (x : [0.B]) → (y : A) → drop0 A B x y ≡ y : A =
λ A B x y ⇒
case x return x' ⇒ drop0 A B x' y ≡ y : A of { [_] ⇒ δ 𝑖 ⇒ y }
def0 HEq : (A B : ★) → A → B → ★¹ =
λ A B x y ⇒ (AB : A ≡ B : ★) × Eq (𝑖 ⇒ AB @𝑖) x y
def0 Sing : (A : ★) → A → ★ =
λ A x ⇒ (val : A) × [0. val ≡ x : A]
def sing : 0.(A : ★) → (x : A) → Sing A x =
λ A x ⇒ (x, [δ _ ⇒ x])
def0 Dup : (A : ★) → A → ★ =
λ A x ⇒ [ω. Sing A x]
def dup-from-parts :
0.(A : ★) →
(dup : A → [ω.A]) →
0.(prf : (x : A) → dup x ≡ [x] : [ω.A]) →
(x : A) → Dup A x =
λ A dup prf x ⇒
case dup x return x! ⇒ 0.(x! ≡ dup x : [ω.A]) → [ω. Sing A x] of {
[x'] ⇒ λ eq ⇒
let0 prf'-ω : [x'] ≡ [x] : [ω.A] =
trans [ω.A] [x'] (dup x) [x] eq (prf x);
prf' : x' ≡ x : A =
δ 𝑖 ⇒ getω A (prf'-ω @𝑖) in
[(x', [prf'])]
} (δ 𝑖 ⇒ dup x)
def drop-from-dup :
0.(A : ★) → (A → [ω.A]) → 0.(B : ★) → A → B → B =
λ A dup B x y ⇒ case dup x return B of { [_] ⇒ y }
namespace sing {
def val : 0.(A : ★) → 0.(x : A) → Sing A x → A =
λ A x sg ⇒
case sg return A of { (x', eq) ⇒ drop0 A (x' ≡ x : A) eq x' }
def0 val-fst : (A : ★) → (x : A) → (sg : Sing A x) → val A x sg ≡ fst sg : A =
λ A x sg ⇒ drop0-eq A (fst sg ≡ x : A) (snd sg) (fst sg)
def0 proof : (A : ★) → (x : A) → (sg : Sing A x) → val A x sg ≡ x : A =
λ A x sg ⇒
trans A (val A x sg) (fst sg) x
(val-fst A x sg) (get0 (fst sg ≡ x : A) (snd sg))
def app : 0.(A B : ★) → 0.(x : A) →
(f : A → B) → Sing A x → Sing B (f x) =
λ A B x f sg ⇒
case sg return Sing B (f x) of { (x_, eq) ⇒
case eq return Sing B (f x) of { [eq] ⇒ (f x_, [δ 𝑖 ⇒ f (eq @𝑖)]) }
}
}