quox/examples/nat.quox

166 lines
4.7 KiB
Text
Raw Normal View History

2023-04-18 18:42:40 -04:00
load "misc.quox";
load "bool.quox";
load "either.quox";
namespace nat {
2023-11-10 09:07:19 -05:00
def elim-0-1 :
0.(P : → ★) →
ω.(P 0) → ω.(P 1) →
ω.(0.(n : ) → P n → P (succ n)) →
(n : ) → P n =
λ P p0 p1 ps n ⇒
case n return n' ⇒ P n' of {
zero ⇒ p0;
succ n' ⇒
case n' return n'' ⇒ P (succ n'') of {
zero ⇒ p1;
succ n'', IH ⇒ ps (succ n'') IH
}
}
2023-11-03 12:42:44 -04:00
#[compile-scheme "(lambda (n) (cons n 'erased))"]
2023-07-22 15:26:20 -04:00
def dup! : (n : ) → [ω. Sing n] =
2023-04-01 13:16:30 -04:00
λ n ⇒
2023-07-22 15:26:20 -04:00
case n return n' ⇒ [ω. Sing n'] of {
zero ⇒ [(zero, [δ _ ⇒ zero])];
2023-11-10 09:07:19 -05:00
succ n, d ⇒
2023-07-22 15:26:20 -04:00
appω (Sing n) (Sing (succ n))
(sing.app n (λ n ⇒ succ n)) d
2023-04-01 13:16:30 -04:00
};
2023-07-22 15:26:20 -04:00
def dup : → [ω.] =
λ n ⇒ appω (Sing n) (sing.val n) (dup! n);
2023-11-03 12:42:44 -04:00
#[compile-scheme "(lambda% (m n) (+ m n))"]
def plus : =
2023-04-01 13:16:30 -04:00
λ m n ⇒
case m return of {
2023-11-10 09:07:19 -05:00
zero ⇒ n;
succ _, p ⇒ succ p
2023-04-01 13:16:30 -04:00
};
2023-11-03 12:42:44 -04:00
#[compile-scheme "(lambda% (m n) (* m n))"]
def timesω : → ω. =
2023-04-01 13:16:30 -04:00
λ m n ⇒
case m return of {
2023-11-10 09:07:19 -05:00
zero ⇒ zero;
succ _, t ⇒ plus n t
2023-04-01 13:16:30 -04:00
};
def times : =
λ m n ⇒ case dup n return of { [n] ⇒ timesω m n };
2023-04-01 13:16:30 -04:00
def pred : = λ n ⇒ case n return of { zero ⇒ zero; succ n ⇒ n };
2023-04-01 13:16:30 -04:00
2023-04-18 18:42:40 -04:00
def pred-succ : ω.(n : ) → pred (succ n) ≡ n : =
λ n ⇒ δ 𝑖 ⇒ n;
2023-04-17 15:44:16 -04:00
def0 succ-inj : (m n : ) → succ m ≡ succ n : → m ≡ n : =
2023-04-18 18:42:40 -04:00
λ m n eq ⇒ δ 𝑖 ⇒ pred (eq @𝑖);
2023-11-05 09:38:38 -05:00
#[compile-scheme "(lambda% (m n) (max 0 (- m n)))"]
def minus : =
λ m n ⇒
(case n return of {
zero ⇒ λ m ⇒ m;
succ _, f ⇒ λ m ⇒ f (pred m)
}) m;
2023-04-18 18:42:40 -04:00
def0 IsSucc : → ★ =
λ n ⇒ case n return ★ of { zero ⇒ False; succ _ ⇒ True };
2023-04-18 18:42:40 -04:00
def isSucc? : ω.(n : ) → Dec (IsSucc n) =
λ n ⇒
caseω n return n' ⇒ Dec (IsSucc n') of {
zero ⇒ No (IsSucc zero) (λ v ⇒ v);
succ n ⇒ Yes (IsSucc (succ n)) 'true
};
def zero-not-succ : 0.(m : ) → Not (zero ≡ succ m : ) =
λ m eq ⇒ coe (𝑖 ⇒ IsSucc (eq @𝑖)) @1 @0 'true;
2023-04-18 18:42:40 -04:00
def succ-not-zero : 0.(m : ) → Not (succ m ≡ zero : ) =
λ m eq ⇒ coe (𝑖 ⇒ IsSucc (eq @𝑖)) 'true;
2023-04-18 18:42:40 -04:00
def0 not-succ-self : (m : ) → Not (m ≡ succ m : ) =
2023-04-18 18:42:40 -04:00
λ m ⇒
case m return m' ⇒ Not (m' ≡ succ m' : ) of {
2023-04-18 18:42:40 -04:00
zero ⇒ zero-not-succ 0;
succ n, ω.ih ⇒ λ eq ⇒ ih (succ-inj n (succ n) eq)
}
2023-11-03 12:42:44 -04:00
#[compile-scheme "(lambda% (m n) (if (= m n) Yes No))"]
2023-04-18 18:42:40 -04:00
def eq? : DecEq =
λ m ⇒
caseω m
return m' ⇒ ω.(n : ) → Dec (m' ≡ n : )
of {
zero ⇒ λ n ⇒
caseω n return n' ⇒ Dec (zero ≡ n' : ) of {
zero ⇒ Yes (zero ≡ zero : ) (δ _ ⇒ zero);
succ n' ⇒ No (zero ≡ succ n' : ) (λ eq ⇒ zero-not-succ n' eq)
};
succ m', ω.ih ⇒ λ n ⇒
caseω n return n' ⇒ Dec (succ m' ≡ n' : ) of {
zero ⇒ No (succ m' ≡ zero : ) (λ eq ⇒ succ-not-zero m' eq);
succ n' ⇒
dec.elim (m' ≡ n' : ) (λ _ ⇒ Dec (succ m' ≡ succ n' : ))
(λ y ⇒ Yes (succ m' ≡ succ n' : ) (δ 𝑖 ⇒ succ (y @𝑖)))
(λ n ⇒ No (succ m' ≡ succ n' : ) (λ eq ⇒ n (succ-inj m' n' eq)))
(ih n')
}
};
2023-04-23 11:33:32 -04:00
def eqb : ω. → ω. → Bool = λ m n ⇒ dec.bool (m ≡ n : ) (eq? m n);
2023-04-18 18:42:40 -04:00
def0 plus-zero : (m : ) → m ≡ plus m 0 : =
2023-04-18 18:42:40 -04:00
λ m ⇒
case m return m' ⇒ m' ≡ plus m' 0 : of {
2023-11-10 09:07:19 -05:00
zero ⇒ δ _ ⇒ 0;
succ m', ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
2023-04-18 18:42:40 -04:00
};
def0 plus-succ : (m n : ) → succ (plus m n) ≡ plus m (succ n) : =
2023-04-18 18:42:40 -04:00
λ m n ⇒
case m return m' ⇒ succ (plus m' n) ≡ plus m' (succ n) : of {
2023-11-10 09:07:19 -05:00
zero ⇒ δ _ ⇒ succ n;
succ _, ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
2023-04-18 18:42:40 -04:00
};
def0 plus-comm : (m n : ) → plus m n ≡ plus n m : =
2023-04-18 18:42:40 -04:00
λ m n ⇒
case m return m' ⇒ plus m' n ≡ plus n m' : of {
2023-04-18 18:42:40 -04:00
zero ⇒ plus-zero n;
2023-11-10 09:07:19 -05:00
succ m', ih ⇒
2023-04-18 18:42:40 -04:00
trans (succ (plus m' n)) (succ (plus n m')) (plus n (succ m'))
𝑖 ⇒ succ (ih @𝑖))
(plus-succ n m')
};
2023-11-10 09:07:19 -05:00
def0 times-zero : (m : ) → 0 ≡ timesω m 0 : =
λ m ⇒
case m return m' ⇒ 0 ≡ timesω m' 0 : of {
zero ⇒ δ _ ⇒ zero;
succ m', ih ⇒ ih
};
{-
-- unfinished
2023-11-10 09:07:19 -05:00
def0 times-succ : (m n : ) → plus m (timesω m n) ≡ timesω m (succ n) : =
λ m n ⇒
case m
return m' ⇒ plus m' (timesω m' n) ≡ timesω m' (succ n) :
of {
zero ⇒ δ _ ⇒ 0;
succ m', ih ⇒
δ 𝑖 ⇒ plus (succ n) (ih @𝑖)
};
-}
2023-11-10 09:07:19 -05:00
2023-04-18 18:42:40 -04:00
}