250 lines
8.8 KiB
Text
250 lines
8.8 KiB
Text
-- False
|
||
|
||
false : * := forall (A : *), A;
|
||
|
||
-- no introduction rule
|
||
|
||
-- elimination rule
|
||
false_elim (A : *) (contra : false) : A := contra A;
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Negation
|
||
|
||
not (A : *) : * := A -> false;
|
||
|
||
-- introduction rule (kinda just the definition)
|
||
not_intro (A : *) (h : A -> false) : not A := h;
|
||
|
||
-- elimination rule
|
||
not_elim (A B : *) (a : A) (na : not A) : B := na a B;
|
||
|
||
-- can introduce double negation (can't eliminate it as that isn't constructive)
|
||
double_neg_intro (A : *) (a : A) : not (not A) :=
|
||
fun (notA : not A) => notA a;
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Conjunction
|
||
|
||
and (A B : *) : * := forall (C : *), (A -> B -> C) -> C;
|
||
|
||
-- introduction rule
|
||
and_intro (A B : *) (a : A) (b : B) : and A B :=
|
||
fun (C : *) (H : A -> B -> C) => H a b;
|
||
|
||
-- left elimination rule
|
||
and_elim_l (A B : *) (ab : and A B) : A :=
|
||
ab A (fun (a : A) (b : B) => a);
|
||
|
||
-- right elimination rule
|
||
and_elim_r (A B : *) (ab : and A B) : B :=
|
||
ab B (fun (a : A) (b : B) => b);
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Disjunction
|
||
|
||
-- 2nd order disjunction
|
||
or (A B : *) : * := forall (C : *), (A -> C) -> (B -> C) -> C;
|
||
|
||
-- left introduction rule
|
||
or_intro_l (A B : *) (a : A) : or A B :=
|
||
fun (C : *) (ha : A -> C) (hb : B -> C) => ha a;
|
||
|
||
-- right introduction rule
|
||
or_intro_r (A B : *) (b : B) : or A B :=
|
||
fun (C : *) (ha : A -> C) (hb : B -> C) => hb b;
|
||
|
||
-- elimination rule (kinda just the definition)
|
||
or_elim (A B C : *) (ab : or A B) (ha : A -> C) (hb : B -> C) : C :=
|
||
ab C ha hb;
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Existential
|
||
|
||
-- 2nd order existential
|
||
exists (A : *) (P : A -> *) : * := forall (C : *), (forall (x : A), P x -> C) -> C;
|
||
|
||
-- introduction rule
|
||
exists_intro (A : *) (P : A -> *) (a : A) (h : P a) : exists A P :=
|
||
fun (C : *) (g : forall (x : A), P x -> C) => g a h;
|
||
|
||
-- elimination rule (kinda just the definition)
|
||
exists_elim (A B : *) (P : A -> *) (ex_a : exists A P) (h : forall (a : A), P a -> B) : B :=
|
||
ex_a B h;
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Universal
|
||
|
||
-- 2nd order universal (just ∏, including it for completeness)
|
||
all (A : *) (P : A -> *) : * := forall (a : A), P a;
|
||
|
||
-- introduction rule
|
||
all_intro (A : *) (P : A -> *) (h : forall (a : A), P a) : all A P := h;
|
||
|
||
-- elimination rule
|
||
all_elim (A : *) (P : A -> *) (h_all : all A P) (a : A) : P a := h_all a;
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Equality
|
||
|
||
-- 2nd order Leibniz equality
|
||
eq (A : *) (x y : A) := forall (P : A -> *), P x -> P y;
|
||
|
||
-- equality is reflexive
|
||
eq_refl (A : *) (x : A) : eq A x x := fun (P : A -> *) (Hx : P x) => Hx;
|
||
|
||
-- equality is symmetric
|
||
eq_sym (A : *) (x y : A) (Hxy : eq A x y) : eq A y x := fun (P : A -> *) (Hy : P y) =>
|
||
Hxy (fun (z : A) => P z -> P x) (fun (Hx : P x) => Hx) Hy;
|
||
|
||
-- equality is transitive
|
||
eq_trans (A : *) (x y z : A) (Hxy : eq A x y) (Hyz : eq A y z) : eq A x z := fun (P : A -> *) (Hx : P x) =>
|
||
Hyz P (Hxy P Hx);
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Some logic theorems
|
||
|
||
-- ~(A ∨ B) => ~A ∧ ~B
|
||
de_morgan1 (A B : *) (h : not (or A B)) : and (not A) (not B) :=
|
||
and_intro (not A) (not B)
|
||
(fun (a : A) => h (or_intro_l A B a))
|
||
(fun (b : B) => h (or_intro_r A B b));
|
||
|
||
-- ~A ∧ ~B => ~(A ∨ B)
|
||
de_morgan2 (A B : *) (h : and (not A) (not B)) : not (or A B) :=
|
||
fun (contra : or A B) =>
|
||
or_elim A B false contra
|
||
(and_elim_l (not A) (not B) h)
|
||
(and_elim_r (not A) (not B) h);
|
||
|
||
-- ~A ∨ ~B => ~(A ∧ B)
|
||
de_morgan3 (A B : *) (h : or (not A) (not B)) : not (and A B) :=
|
||
fun (contra : and A B) =>
|
||
or_elim (not A) (not B) false h
|
||
(fun (na : not A) => na (and_elim_l A B contra))
|
||
(fun (nb : not B) => nb (and_elim_r A B contra));
|
||
|
||
-- the last one (~(A ∧ B) => ~A ∨ ~B) is not possible constructively
|
||
|
||
-- A ∧ B => B ∧ A
|
||
and_comm (A B : *) (h : and A B) : and B A :=
|
||
and_intro B A
|
||
(and_elim_r A B h)
|
||
(and_elim_l A B h);
|
||
|
||
-- A ∨ B => B ∨ A
|
||
or_comm (A B : *) (h : or A B) : or B A :=
|
||
or_elim A B (or B A) h
|
||
(fun (a : A) => or_intro_r B A a)
|
||
(fun (b : B) => or_intro_l B A b);
|
||
|
||
-- A ∧ (B ∧ C) => (A ∧ B) ∧ C
|
||
and_assoc_l (A B C : *) (h : and A (and B C)) : and (and A B) C :=
|
||
and_intro (and A B) C
|
||
(and_intro A B
|
||
(and_elim_l A (and B C) h)
|
||
(and_elim_l B C (and_elim_r A (and B C) h)))
|
||
(and_elim_r B C (and_elim_r A (and B C) h));
|
||
|
||
-- (A ∧ B) ∧ C => A ∧ (B ∧ C)
|
||
and_assoc_r (A B C : *) (h : and (and A B) C) : and A (and B C) :=
|
||
and_intro A (and B C)
|
||
(and_elim_l A B (and_elim_l (and A B) C h))
|
||
(and_intro B C
|
||
(and_elim_r A B (and_elim_l (and A B) C h))
|
||
(and_elim_r (and A B) C h));
|
||
|
||
-- A ∨ (B ∨ C) => (A ∨ B) ∨ C
|
||
or_assoc_l (A B C : *) (h : or A (or B C)) : or (or A B) C :=
|
||
or_elim A (or B C) (or (or A B) C) h
|
||
(fun (a : A) => or_intro_l (or A B) C (or_intro_l A B a))
|
||
(fun (g : or B C) =>
|
||
or_elim B C (or (or A B) C) g
|
||
(fun (b : B) => or_intro_l (or A B) C (or_intro_r A B b))
|
||
(fun (c : C) => or_intro_r (or A B) C c));
|
||
|
||
-- (A ∨ B) ∨ C => A ∨ (B ∨ C)
|
||
or_assoc_r (A B C : *) (h : or (or A B) C) : or A (or B C) :=
|
||
or_elim (or A B) C (or A (or B C)) h
|
||
(fun (g : or A B) =>
|
||
or_elim A B (or A (or B C)) g
|
||
(fun (a : A) => or_intro_l A (or B C) a)
|
||
(fun (b : B) => or_intro_r A (or B C) (or_intro_l B C b)))
|
||
(fun (c : C) => or_intro_r A (or B C) (or_intro_r B C c));
|
||
|
||
-- A ∧ (B ∨ C) => A ∧ B ∨ A ∧ C
|
||
and_distrib_l_or (A B C : *) (h : and A (or B C)) : or (and A B) (and A C) :=
|
||
or_elim B C (or (and A B) (and A C)) (and_elim_r A (or B C) h)
|
||
(fun (b : B) => or_intro_l (and A B) (and A C)
|
||
(and_intro A B (and_elim_l A (or B C) h) b))
|
||
(fun (c : C) => or_intro_r (and A B) (and A C)
|
||
(and_intro A C (and_elim_l A (or B C) h) c));
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- very little very basic algebra
|
||
|
||
-- what it means for a set and operation to be a semigroup
|
||
semigroup (M : *) (op : M -> M -> M) : * :=
|
||
forall (a b c : M), eq M (op (op a b) c) (op a (op b c));
|
||
|
||
-- what it means for a set, operation, and identity element to be a monoid
|
||
monoid (M : *) (op : M -> M -> M) (e : M) : * :=
|
||
and (semigroup M op)
|
||
(and (forall (a : M), eq M (op a e) a)
|
||
(forall (a : M), eq M (op e a) a));
|
||
|
||
-- identity elements in monoids are unique
|
||
monoid_identity_unique
|
||
(M : *) (op : M -> M -> M) (e : M) (Hmonoid : monoid M op e)
|
||
(a : M) (H : forall (b : M), eq M (op a b) b) : eq M a e :=
|
||
eq_trans M a (op a e) e
|
||
-- a = a * e
|
||
(eq_sym M (op a e) a
|
||
(and_elim_l
|
||
(forall (a : M), eq M (op a e) a)
|
||
(forall (a : M), eq M (op e a) a)
|
||
(and_elim_r
|
||
(semigroup M op)
|
||
(and (forall (a : M), eq M (op a e) a) (forall (a : M), eq M (op e a) a))
|
||
Hmonoid) a))
|
||
|
||
-- a * e = e
|
||
(H e);
|
||
|
||
|
||
-- what it means for a set, operation, identity element, and inverse map to be a group
|
||
group (G : *) (op : G -> G -> G) (e : G) (inv : G -> G) : * :=
|
||
and (monoid G op e)
|
||
(and (forall (a : G), eq G (op a (inv a)) e)
|
||
(forall (a : G), eq G (op (inv a) a) e));
|
||
|
||
-- --------------------------------------------------------------------------------------------------------------
|
||
|
||
-- Church numerals
|
||
|
||
nat : * := forall (A : *), (A -> A) -> A -> A;
|
||
|
||
-- zero is the constant function
|
||
zero : nat := fun (A : *) (f : A -> A) (x : A) => x;
|
||
|
||
-- `suc n` composes one more `f` than `n`
|
||
suc : nat -> nat := fun (n : nat) (A : *) (f : A -> A) (x : A) => f ((n A f) x);
|
||
|
||
-- addition as usual
|
||
add : nat -> nat -> nat := fun (n m : nat) (A : *) (f : A -> A) (x : A) => (m A f) (n A f x);
|
||
|
||
-- multiplication as usual
|
||
mul : nat -> nat -> nat := fun (n m : nat) (A : *) (f : A -> A) (x : A) => (m A (n A f)) x;
|
||
|
||
-- unforunately, I believe it is impossible to prove induction on Church numerals,
|
||
-- which makes it really hard to prove standard theorems, or do anything really.
|
||
|
||
-- with a primitive notion system, we could stipulate the existence of a type of
|
||
-- natural numbers satisfying the Peano axioms, but I haven't implemented that yet.
|