quox/examples/pair.quox

75 lines
2.4 KiB
Text
Raw Normal View History

2023-04-18 18:42:40 -04:00
namespace pair {
2023-09-17 08:41:29 -04:00
def0 Σ : (A : ★) → (A → ★) → ★ = λ A B ⇒ (x : A) × B x;
2023-04-18 18:42:40 -04:00
2023-09-18 18:41:17 -04:00
{-
-- now builtins
2023-09-17 08:41:29 -04:00
def fst : 0.(A : ★) → 0.(B : A → ★) → ω.(Σ A B) → A =
2023-04-18 18:42:40 -04:00
λ A B p ⇒ caseω p return A of { (x, _) ⇒ x };
2023-09-17 08:41:29 -04:00
def snd : 0.(A : ★) → 0.(B : A → ★) → ω.(p : Σ A B) → B (fst A B p) =
2023-04-18 18:42:40 -04:00
λ A B p ⇒ caseω p return p' ⇒ B (fst A B p') of { (_, y) ⇒ y };
2023-09-18 18:41:17 -04:00
-}
2023-04-18 18:42:40 -04:00
def uncurry :
2023-09-17 08:41:29 -04:00
0.(A : ★) → 0.(B : A → ★) → 0.(C : (x : A) → (B x) → ★) →
(f : (x : A) → (y : B x) → C x y) →
2023-09-18 18:41:17 -04:00
(p : Σ A B) → C (fst p) (snd p) =
2023-04-18 18:42:40 -04:00
λ A B C f p ⇒
2023-09-18 18:41:17 -04:00
case p return p' ⇒ C (fst p') (snd p') of { (x, y) ⇒ f x y };
2023-04-18 18:42:40 -04:00
def uncurry' :
0.(A B C : ★) → (A → B → C) → (A × B) → C =
λ A B C ⇒ uncurry A (λ _ ⇒ B) (λ _ _ ⇒ C);
2023-04-18 18:42:40 -04:00
def curry :
2023-09-17 08:41:29 -04:00
0.(A : ★) → 0.(B : A → ★) → 0.(C : (Σ A B) → ★) →
(f : (p : Σ A B) → C p) → (x : A) → (y : B x) → C (x, y) =
2023-04-18 18:42:40 -04:00
λ A B C f x y ⇒ f (x, y);
def curry' :
0.(A B C : ★) → (A × B → C) → A → B → C =
λ A B C ⇒ curry A (λ _ ⇒ B) (λ _ ⇒ C);
2023-04-18 18:42:40 -04:00
def0 fst-snd :
2023-09-17 08:41:29 -04:00
(A : ★) → (B : A → ★) →
2023-09-18 18:41:17 -04:00
(p : Σ A B) → p ≡ (fst p, snd p) : Σ A B =
2023-04-18 18:42:40 -04:00
λ A B p ⇒
case p
2023-09-18 18:41:17 -04:00
return p' ⇒ p' ≡ (fst p', snd p') : Σ A B
2023-04-18 18:42:40 -04:00
of { (x, y) ⇒ δ 𝑖 ⇒ (x, y) };
2023-09-17 08:41:29 -04:00
def0 fst-eq :
(A : ★) → (B : A → ★) →
2023-09-18 18:41:17 -04:00
(p q : Σ A B) → p ≡ q : Σ A B → fst p ≡ fst q : A =
λ A B p q eq ⇒ δ 𝑖 ⇒ fst (eq @𝑖);
2023-09-17 08:41:29 -04:00
def0 snd-eq :
(A : ★) → (B : A → ★) →
(p q : Σ A B) → (eq : p ≡ q : Σ A B) →
2023-09-18 18:41:17 -04:00
Eq (𝑖 ⇒ B (fst-eq A B p q eq @𝑖)) (snd p) (snd q) =
λ A B p q eq ⇒ δ 𝑖 ⇒ snd (eq @𝑖);
2023-09-17 08:41:29 -04:00
2023-04-18 18:42:40 -04:00
def map :
2023-05-21 14:33:42 -04:00
0.(A A' : ★) →
2023-09-17 08:41:29 -04:00
0.(B : A → ★) → 0.(B' : A' → ★) →
(f : A → A') → (g : 0.(x : A) → (B x) → B' (f x)) →
Σ A B → Σ A' B' =
2023-04-18 18:42:40 -04:00
λ A A' B B' f g p ⇒
case p return Σ A' B' of { (x, y) ⇒ (f x, g x y) };
2023-04-18 18:42:40 -04:00
def map' : 0.(A A' B B' : ★) → (A → A') → (B → B') → (A × B) → A' × B' =
2023-04-18 18:42:40 -04:00
λ A A' B B' f g ⇒ map A A' (λ _ ⇒ B) (λ _ ⇒ B') f (λ _ ⇒ g);
def map-fst : 0.(A A' B : ★) → (A → A') → A × B → A' × B =
λ A A' B f ⇒ map' A A' B B f (λ x ⇒ x);
def map-snd : 0.(A B B' : ★) → (B → B') → A × B → A × B' =
λ A B B' f ⇒ map' A A B B' (λ x ⇒ x) f;
2023-04-18 18:42:40 -04:00
}
def0 Σ = pair.Σ;
2023-09-18 18:41:17 -04:00
-- def fst = pair.fst;
-- def snd = pair.snd;