This commit is contained in:
rhiannon morris 2023-07-18 15:15:05 +02:00
parent 349cf2f477
commit 7b3a4b1c72
7 changed files with 67 additions and 70 deletions

View File

@ -4,24 +4,24 @@ namespace bool {
def0 Bool : ★ = {true, false};
def boolω : 1.Bool → [ω.Bool] =
def boolω : Bool → [ω.Bool] =
λ b ⇒ case1 b return [ω.Bool] of { 'true ⇒ ['true]; 'false ⇒ ['false] };
def if : 0.(A : ★) → 1.Bool → ω.A → ω.A → A =
def if : 0.(A : ★) → Bool → ω.A → ω.A → A =
λ A b t f ⇒ case1 b return A of { 'true ⇒ t; 'false ⇒ f };
def0 If : 1.Bool → 0.★ → 0.★ → ★ =
def0 If : Bool → ★ → ★ → ★ =
λ b T F ⇒ case1 b return ★ of { 'true ⇒ T; 'false ⇒ F };
def0 T : ω.Bool → ★ = λ b ⇒ If b True False;
def0 T : Bool → ★ = λ b ⇒ If b True False;
def true-not-false : Not ('true ≡ 'false : Bool) =
λ eq ⇒ coe (i ⇒ T (eq @i)) 'true;
-- [todo] infix
def and : 1.Bool → ω.Bool → Bool = λ a b ⇒ if Bool a b 'false;
def or : 1.Bool → ω.Bool → Bool = λ a b ⇒ if Bool a 'true b;
def and : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a b 'false;
def or : Bool → ω.Bool → Bool = λ a b ⇒ if Bool a 'true b;
}

View File

@ -5,33 +5,33 @@ namespace either {
def0 Tag : ★ = {left, right};
def0 Payload : 0.★ → 0.★ → 1.Tag → ★ =
def0 Payload : ★ → ★ → Tag → ★ =
λ A B tag ⇒ case1 tag return ★ of { 'left ⇒ A; 'right ⇒ B };
def0 Either : 0.★ → 0.★ → ★ =
def0 Either : ★ → ★ → ★ =
λ A B ⇒ (tag : Tag) × Payload A B tag;
def Left : 0.(A B : ★) → 1.A → Either A B =
def Left : 0.(A B : ★) → A → Either A B =
λ A B x ⇒ ('left, x);
def Right : 0.(A B : ★) → 1.B → Either A B =
def Right : 0.(A B : ★) → B → Either A B =
λ A B x ⇒ ('right, x);
def elim' :
0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
ω.(1.(x : A) → P (Left A B x)) →
ω.(1.(x : B) → P (Right A B x)) →
1.(t : Tag) → 1.(a : Payload A B t) → P (t, a) =
ω.((x : A) → P (Left A B x)) →
ω.((x : B) → P (Right A B x)) →
(t : Tag) → (a : Payload A B t) → P (t, a) =
λ A B P f g t ⇒
case1 t
return t' ⇒ 1.(a : Payload A B t') → P (t', a)
return t' ⇒ (a : Payload A B t') → P (t', a)
of { 'left ⇒ f; 'right ⇒ g };
def elim :
0.(A B : ★) → 0.(P : 0.(Either A B) → ★) →
ω.(1.(x : A) → P (Left A B x)) →
ω.(1.(x : B) → P (Right A B x)) →
1.(x : Either A B) → P x =
ω.((x : A) → P (Left A B x)) →
ω.((x : B) → P (Right A B x)) →
(x : Either A B) → P x =
λ A B P f g e ⇒
case1 e return e' ⇒ P e' of { (t, a) ⇒ elim' A B P f g t a };
@ -45,25 +45,25 @@ def Right = either.Right;
namespace dec {
def0 Dec : 0.★ → ★ = λ A ⇒ Either [0.A] [0.Not A];
def0 Dec : ★ → ★ = λ A ⇒ Either [0.A] [0.Not A];
def Yes : 0.(A : ★) → 0.A → Dec A = λ A y ⇒ Left [0.A] [0.Not A] [y];
def No : 0.(A : ★) → 0.(Not A) → Dec A = λ A n ⇒ Right [0.A] [0.Not A] [n];
def0 DecEq : 0.★ → ★ =
def0 DecEq : ★ → ★ =
λ A ⇒ ω.(x : A) → ω.(y : A) → Dec (x ≡ y : A);
def elim :
0.(A : ★) → 0.(P : 0.(Dec A) → ★) →
ω.(0.(y : A) → P (Yes A y)) →
ω.(0.(n : Not A) → P (No A n)) →
1.(x : Dec A) → P x =
(x : Dec A) → P x =
λ A P f g ⇒
either.elim [0.A] [0.Not A] P
(λ y ⇒ case0 y return y' ⇒ P (Left [0.A] [0.Not A] y') of {[y'] ⇒ f y'})
(λ n ⇒ case0 n return n' ⇒ P (Right [0.A] [0.Not A] n') of {[n'] ⇒ g n'});
def bool : 0.(A : ★) → 1.(Dec A) → Bool =
def bool : 0.(A : ★) → Dec A → Bool =
λ A ⇒ elim A (λ _ ⇒ Bool) (λ _ ⇒ 'true) (λ _ ⇒ 'false);
}

View File

@ -2,37 +2,37 @@ load "nat.quox";
namespace list {
def0 Vec : 0.0.★ → ★ =
def0 Vec : → ★ → ★ =
λ n A ⇒
caseω n return ★ of {
zero ⇒ {nil};
succ _, 0.Tail ⇒ A × Tail
};
def0 List : 0.★ → ★ =
def0 List : ★ → ★ =
λ A ⇒ (len : ) × Vec len A;
def nil : 0.(A : ★) → List A =
λ A ⇒ (0, 'nil);
def cons : 0.(A : ★) → 1.A → 1.(List A) → List A =
def cons : 0.(A : ★) → A → List A → List A =
λ A x xs ⇒ case1 xs return List A of { (len, elems) ⇒ (succ len, x, elems) };
def foldr' : 0.(A B : ★) →
1.B → ω.(1.A → 1.B → B) → 1.(n : ) → 1.(Vec n A) → B =
B → ω.(A → B → B) → (n : ) → Vec n A → B =
λ A B z c n ⇒
case1 n return n' ⇒ 1.(Vec n' A) → B of {
case1 n return n' ⇒ Vec n' A → B of {
zero ⇒
λ nil ⇒ case1 nil return B of { 'nil ⇒ z };
succ n, 1.ih ⇒
λ cons ⇒ case1 cons return B of { (first, rest) ⇒ c first (ih rest) }
};
def foldr : 0.(A B : ★) → 1.B → ω.(1.A → 1.B → B) → 1.(List A) → B =
def foldr : 0.(A B : ★) → B → ω.(A → B → B) → List A → B =
λ A B z c xs ⇒
case1 xs return B of { (len, elems) ⇒ foldr' A B z c len elems };
def sum : 1.(List ) = foldr 0 nat.plus;
def sum : List = foldr 0 nat.plus;
def numbers : List = (5, (0, 1, 2, 3, 4, 'nil));

View File

@ -5,10 +5,10 @@ namespace maybe {
def0 Tag : ★ = {nothing, just}
def0 Payload : ω.Tag → ω.★ → ★ =
def0 Payload : Tag → ★ → ★ =
λ tag A ⇒ caseω tag return ★ of { 'nothing ⇒ True; 'just ⇒ A }
def0 Maybe : ω.★ → ★ =
def0 Maybe : ★ → ★ =
λ A ⇒ (t : Tag) × Payload t A
def tag : 0.(A : ★) → ω.(Maybe A) → Tag =
@ -17,13 +17,13 @@ def tag : 0.(A : ★) → ω.(Maybe A) → Tag =
def Nothing : 0.(A : ★) → Maybe A =
λ _ ⇒ ('nothing, 'true)
def Just : 0.(A : ★) → 1.A → Maybe A =
def Just : 0.(A : ★) → A → Maybe A =
λ _ x ⇒ ('just, x)
def0 IsJustTag : ω.Tag → ★ =
def0 IsJustTag : Tag → ★ =
λ t ⇒ caseω t return ★ of { 'just ⇒ True; 'nothing ⇒ False }
def0 IsJust : 0.(A : ★) → ω.(Maybe A) → ★ =
def0 IsJust : (A : ★) → Maybe A → ★ =
λ A x ⇒ IsJustTag (tag A x)
def is-just? : 0.(A : ★) → ω.(x : Maybe A) → Dec (IsJust A x) =
@ -34,7 +34,7 @@ def is-just? : 0.(A : ★) → ω.(x : Maybe A) → Dec (IsJust A x) =
}
def0 nothing-unique :
0.(A : ★) → ω.(x : True) → ('nothing, x) ≡ Nothing A : Maybe A =
(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)
@ -44,8 +44,8 @@ def elim :
0.(A : ★) →
0.(P : 0.(Maybe A) → ★) →
ω.(P (Nothing A)) →
ω.(1.(x : A) → P (Just A x)) →
1.(x : Maybe A) → P x =
ω.((x : A) → P (Just A x)) →
(x : Maybe A) → P x =
λ A P n j x ⇒
case1 x return x' ⇒ P x' of { (tag, payload) ⇒
(case1 tag

View File

@ -1,33 +1,31 @@
def0 True : ★ = {true}
def0 False : ★ = {}
def0 Not : 0.★ → ★ = λ A ⇒ ω.A → False
def0 Not : ★ → ★ = λ A ⇒ ω.A → False
def void : 0.(A : ★) → 0.False → A =
λ A v ⇒ case0 v return A of { }
def0 Pred : 0.★ → ★¹ = λ A ⇒ 0.A → ★
def0 All : 0.(A : ★) → 0.(Pred A) → ★¹ =
λ A P ⇒ 1.(x : A) → P x
def0 All : (A : ★) → (0.A → ★) → ★¹ =
λ A P ⇒ (x : A) → P x
def cong :
0.(A : ★) → 0.(P : Pred A) → 1.(p : All A P) →
0.(x y : A) → 1.(xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
0.(A : ★) → 0.(P : 0.A → ★) → (p : All A P) →
0.(x y : A) → (xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
λ A P p x y xy ⇒ δ 𝑖 ⇒ p (xy @𝑖)
def0 eq-f :
0.(A : ★) → 0.(P : Pred A) →
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 : Pred A) → 0.(p q : All A P) →
1.(All A (eq-f A P p q)) → p ≡ q : All A P =
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 sym : 0.(A : ★) → 0.(x y : A) → 1.(x ≡ y : A) → y ≡ x : A =
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) →

View File

@ -4,40 +4,40 @@ load "either.quox";
namespace nat {
def dup : 1. → [ω.] =
def dup : → [ω.] =
λ n ⇒
case1 n return [ω.] of {
zero ⇒ [zero];
succ _, 1.d ⇒ case1 d return [ω.] of { [d] ⇒ [succ d] }
};
def plus : 1.1. =
def plus : =
λ m n ⇒
case1 m return of {
zero ⇒ n;
succ _, 1.p ⇒ succ p
};
def timesω : 1. → ω. =
def timesω : → ω. =
λ m n ⇒
case1 m return of {
zero ⇒ zero;
succ _, 1.t ⇒ plus n t
};
def times : 1.1. =
def times : =
λ m n ⇒ case1 dup n return of { [n] ⇒ timesω m n };
def pred : 1. = λ n ⇒ case1 n return of { zero ⇒ zero; succ n ⇒ n };
def pred : = λ n ⇒ case1 n return of { zero ⇒ zero; succ n ⇒ n };
def pred-succ : ω.(n : ) → pred (succ n) ≡ n : =
λ n ⇒ δ 𝑖 ⇒ n;
def0 succ-inj : 0.(m n : ) → 0.(succ m ≡ succ n : ) → m ≡ n : =
def0 succ-inj : (m n : ) → succ m ≡ succ n : → m ≡ n : =
λ m n eq ⇒ δ 𝑖 ⇒ pred (eq @𝑖);
def0 IsSucc : 0. → ★ =
def0 IsSucc : → ★ =
λ n ⇒ caseω n return ★ of { zero ⇒ False; succ _ ⇒ True };
def isSucc? : ω.(n : ) → Dec (IsSucc n) =
@ -54,7 +54,7 @@ def succ-not-zero : 0.(m : ) → Not (succ m ≡ zero : ) =
λ m eq ⇒ coe (𝑖 ⇒ IsSucc (eq @𝑖)) 'true;
def0 not-succ-self : 0.(m : ) → Not (m ≡ succ m : ) =
def0 not-succ-self : (m : ) → Not (m ≡ succ m : ) =
λ m ⇒
caseω m return m' ⇒ Not (m' ≡ succ m' : ) of {
zero ⇒ zero-not-succ 0;
@ -86,21 +86,21 @@ def eq? : DecEq =
def eqb : ω. → ω. → Bool = λ m n ⇒ dec.bool (m ≡ n : ) (eq? m n);
def0 plus-zero : 0.(m : ) → m ≡ plus m 0 : =
def0 plus-zero : (m : ) → m ≡ plus m 0 : =
λ m ⇒
caseω m return m' ⇒ m' ≡ plus m' 0 : of {
zero ⇒ δ _ ⇒ zero;
succ _, ω.ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
};
def0 plus-succ : 0.(m n : ) → succ (plus m n) ≡ plus m (succ n) : =
def0 plus-succ : (m n : ) → succ (plus m n) ≡ plus m (succ n) : =
λ m n ⇒
caseω m return m' ⇒ succ (plus m' n) ≡ plus m' (succ n) : of {
zero ⇒ δ _ ⇒ succ n;
succ _, ω.ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
};
def0 plus-comm : 0.(m n : ) → plus m n ≡ plus n m : =
def0 plus-comm : (m n : ) → plus m n ≡ plus n m : =
λ m n ⇒
caseω m return m' ⇒ plus m' n ≡ plus n m' : of {
zero ⇒ plus-zero n;

View File

@ -1,6 +1,6 @@
namespace pair {
def0 Σ : 0.(A : ★) → 0.(0.A → ★) → ★ = λ A B ⇒ (x : A) × B x;
def0 Σ : (A : ★) → (0.A → ★) → ★ = λ A B ⇒ (x : A) × B x;
def fst : 0.(A : ★) → 0.(B : 0.A → ★) → ω.(Σ A B) → A =
λ A B p ⇒ caseω p return A of { (x, _) ⇒ x };
@ -10,27 +10,27 @@ def snd : 0.(A : ★) → 0.(B : 0.A → ★) → ω.(p : Σ A B) → B (fst A B
def uncurry :
0.(A : ★) → 0.(B : 0.A → ★) → 0.(C : 0.(x : A) → 0.(B x) → ★) →
1.(f : 1.(x : A) → 1.(y : B x) → C x y) →
1.(p : Σ A B) → C (fst A B p) (snd A B p) =
(f : (x : A) → (y : B x) → C x y) →
(p : Σ A B) → C (fst A B p) (snd A B p) =
λ A B C f p ⇒
case1 p return p' ⇒ C (fst A B p') (snd A B p') of { (x, y) ⇒ f x y };
def uncurry' :
0.(A B C : ★) → 1.(1.A → 1.B → C) → 1.(A × B) → C =
0.(A B C : ★) → (A → B → C) → (A × B) → C =
λ A B C ⇒ uncurry A (λ _ ⇒ B) (λ _ _ ⇒ C);
def curry :
0.(A : ★) → 0.(B : 0.A → ★) → 0.(C : 0.(Σ A B) → ★) →
1.(f : 1.(p : Σ A B) → C p) → 1.(x : A) → 1.(y : B x) → C (x, y) =
(f : (p : Σ A B) → C p) → (x : A) → (y : B x) → C (x, y) =
λ A B C f x y ⇒ f (x, y);
def curry' :
0.(A B C : ★) → 1.(1.(A × B) → C) → 1.A → 1.B → C =
0.(A B C : ★) → ((A × B) → C) → A → B → C =
λ A B C ⇒ curry A (λ _ ⇒ B) (λ _ ⇒ C);
def0 fst-snd :
0.(A : ★) → 0.(B : 0.A → ★) →
1.(p : Σ A B) → p ≡ (fst A B p, snd A B p) : Σ A B =
(A : ★) → (B : 0.A → ★) →
(p : Σ A B) → p ≡ (fst A B p, snd A B p) : Σ A B =
λ A B p ⇒
case1 p
return p' ⇒ p' ≡ (fst A B p', snd A B p') : Σ A B
@ -39,13 +39,12 @@ def0 fst-snd :
def map :
0.(A A' : ★) →
0.(B : 0.A → ★) → 0.(B' : 0.A' → ★) →
1.(f : 1.A → A') → 1.(g : 0.(x : A) → 1.(B x) → B' (f x)) →
1.(Σ A B) → Σ A' B' =
(f : A → A') → (g : 0.(x : A) → (B x) → B' (f x)) →
(Σ A B) → Σ A' B' =
λ A A' B B' f g p ⇒
case1 p return Σ A' B' of { (x, y) ⇒ (f x, g x y) };
def map' : 0.(A A' B B' : ★) →
1.(1.A → A') → 1.(1.B → B') → 1.(A × B) → A' × B' =
def map' : 0.(A A' B B' : ★) → (A → A') → (B → B') → (A × B) → A' × B' =
λ A A' B B' f g ⇒ map A A' (λ _ ⇒ B) (λ _ ⇒ B') f (λ _ ⇒ g);
}