example stuff
This commit is contained in:
parent
cc78ccd940
commit
d115672d49
4 changed files with 54 additions and 15 deletions
|
@ -3,8 +3,6 @@ def0 Unit : ★ = {tt}
|
||||||
def drop-unit : 0.(A : ★) → Unit → A → A =
|
def drop-unit : 0.(A : ★) → Unit → A → A =
|
||||||
λ A u x ⇒ case u return A of {'tt ⇒ x}
|
λ A u x ⇒ case u return A of {'tt ⇒ x}
|
||||||
|
|
||||||
-- postulate0 IOState : ★
|
|
||||||
|
|
||||||
def0 IO : ★ → ★ = λ A ⇒ IOState → A × IOState
|
def0 IO : ★ → ★ = λ A ⇒ IOState → A × IOState
|
||||||
|
|
||||||
def bind : 0.(A B : ★) → IO A → (A → IO B) → IO B =
|
def bind : 0.(A B : ★) → IO A → (A → IO B) → IO B =
|
||||||
|
|
|
@ -14,6 +14,11 @@ def0 cong :
|
||||||
(x y : A) → (xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
|
(x y : A) → (xy : x ≡ y : A) → Eq (𝑖 ⇒ P (xy @𝑖)) (p x) (p y) =
|
||||||
λ A P p x y xy ⇒ δ 𝑖 ⇒ p (xy @𝑖)
|
λ 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 :
|
def0 coherence :
|
||||||
(A B : ★) → (AB : A ≡ B : ★) → (x : A) →
|
(A B : ★) → (AB : A ≡ B : ★) → (x : A) →
|
||||||
Eq (𝑖 ⇒ AB @𝑖) x (coe (𝑖 ⇒ AB @𝑖) x) =
|
Eq (𝑖 ⇒ AB @𝑖) x (coe (𝑖 ⇒ AB @𝑖) x) =
|
||||||
|
|
|
@ -4,12 +4,27 @@ load "either.quox";
|
||||||
|
|
||||||
namespace nat {
|
namespace nat {
|
||||||
|
|
||||||
|
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
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
#[compile-scheme "(lambda (n) (cons n 'erased))"]
|
#[compile-scheme "(lambda (n) (cons n 'erased))"]
|
||||||
def dup! : (n : ℕ) → [ω. Sing ℕ n] =
|
def dup! : (n : ℕ) → [ω. Sing ℕ n] =
|
||||||
λ n ⇒
|
λ n ⇒
|
||||||
case n return n' ⇒ [ω. Sing ℕ n'] of {
|
case n return n' ⇒ [ω. Sing ℕ n'] of {
|
||||||
zero ⇒ [(zero, [δ _ ⇒ zero])];
|
zero ⇒ [(zero, [δ _ ⇒ zero])];
|
||||||
succ n, 1.d ⇒
|
succ n, d ⇒
|
||||||
appω (Sing ℕ n) (Sing ℕ (succ n))
|
appω (Sing ℕ n) (Sing ℕ (succ n))
|
||||||
(sing.app ℕ ℕ n (λ n ⇒ succ n)) d
|
(sing.app ℕ ℕ n (λ n ⇒ succ n)) d
|
||||||
};
|
};
|
||||||
|
@ -22,7 +37,7 @@ def plus : ℕ → ℕ → ℕ =
|
||||||
λ m n ⇒
|
λ m n ⇒
|
||||||
case m return ℕ of {
|
case m return ℕ of {
|
||||||
zero ⇒ n;
|
zero ⇒ n;
|
||||||
succ _, 1.p ⇒ succ p
|
succ _, p ⇒ succ p
|
||||||
};
|
};
|
||||||
|
|
||||||
#[compile-scheme "(lambda% (m n) (* m n))"]
|
#[compile-scheme "(lambda% (m n) (* m n))"]
|
||||||
|
@ -30,7 +45,7 @@ def timesω : ℕ → ω.ℕ → ℕ =
|
||||||
λ m n ⇒
|
λ m n ⇒
|
||||||
case m return ℕ of {
|
case m return ℕ of {
|
||||||
zero ⇒ zero;
|
zero ⇒ zero;
|
||||||
succ _, 1.t ⇒ plus n t
|
succ _, t ⇒ plus n t
|
||||||
};
|
};
|
||||||
|
|
||||||
def times : ℕ → ℕ → ℕ =
|
def times : ℕ → ℕ → ℕ =
|
||||||
|
@ -106,25 +121,42 @@ def eqb : ω.ℕ → ω.ℕ → Bool = λ m n ⇒ dec.bool (m ≡ n : ℕ) (eq?
|
||||||
def0 plus-zero : (m : ℕ) → m ≡ plus m 0 : ℕ =
|
def0 plus-zero : (m : ℕ) → m ≡ plus m 0 : ℕ =
|
||||||
λ m ⇒
|
λ m ⇒
|
||||||
case m return m' ⇒ m' ≡ plus m' 0 : ℕ of {
|
case m return m' ⇒ m' ≡ plus m' 0 : ℕ of {
|
||||||
zero ⇒ δ _ ⇒ zero;
|
zero ⇒ δ _ ⇒ 0;
|
||||||
succ _, ω.ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
|
succ m', ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
|
||||||
};
|
};
|
||||||
|
|
||||||
def0 plus-succ : (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 ⇒
|
λ m n ⇒
|
||||||
case m return m' ⇒ succ (plus m' n) ≡ plus m' (succ n) : ℕ of {
|
case m return m' ⇒ succ (plus m' n) ≡ plus m' (succ n) : ℕ of {
|
||||||
zero ⇒ δ _ ⇒ succ n;
|
zero ⇒ δ _ ⇒ succ n;
|
||||||
succ _, ω.ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
|
succ _, ih ⇒ δ 𝑖 ⇒ succ (ih @𝑖)
|
||||||
};
|
};
|
||||||
|
|
||||||
def0 plus-comm : (m n : ℕ) → plus m n ≡ plus n m : ℕ =
|
def0 plus-comm : (m n : ℕ) → plus m n ≡ plus n m : ℕ =
|
||||||
λ m n ⇒
|
λ m n ⇒
|
||||||
case m return m' ⇒ plus m' n ≡ plus n m' : ℕ of {
|
case m return m' ⇒ plus m' n ≡ plus n m' : ℕ of {
|
||||||
zero ⇒ plus-zero n;
|
zero ⇒ plus-zero n;
|
||||||
succ m', ω.ih ⇒
|
succ m', ih ⇒
|
||||||
trans ℕ (succ (plus m' n)) (succ (plus n m')) (plus n (succ m'))
|
trans ℕ (succ (plus m' n)) (succ (plus n m')) (plus n (succ m'))
|
||||||
(δ 𝑖 ⇒ succ (ih @𝑖))
|
(δ 𝑖 ⇒ succ (ih @𝑖))
|
||||||
(plus-succ n m')
|
(plus-succ n m')
|
||||||
};
|
};
|
||||||
|
|
||||||
|
def0 times-zero : (m : ℕ) → 0 ≡ timesω m 0 : ℕ =
|
||||||
|
λ m ⇒
|
||||||
|
case m return m' ⇒ 0 ≡ timesω m' 0 : ℕ of {
|
||||||
|
zero ⇒ δ _ ⇒ zero;
|
||||||
|
succ m', ih ⇒ ih
|
||||||
|
};
|
||||||
|
|
||||||
|
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 @𝑖)
|
||||||
|
};
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -61,13 +61,17 @@ def0 unbox : (π : Qty) → (A : ★) → Box π A → A =
|
||||||
'any ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
|
'any ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
|
||||||
}
|
}
|
||||||
|
|
||||||
|
def0 unbox0 = unbox 'zero
|
||||||
|
def0 unbox1 = unbox 'one
|
||||||
|
def0 unboxω = unbox 'any
|
||||||
|
|
||||||
def apply : (π : Qty) → 0.(A : ★) → 0.(B : A → ★) →
|
def apply : (π : Qty) → 0.(A : ★) → 0.(B : A → ★) →
|
||||||
FUN π A B → (x : Box π A) → B (unbox π A x) =
|
FUN π A B → (x : Box π A) → B (unbox π A x) =
|
||||||
λ π A B ⇒
|
λ π A B ⇒
|
||||||
case π
|
case π
|
||||||
return π' ⇒ FUN π' A B → (x : Box π' A) → B (unbox π' A x)
|
return π' ⇒ FUN π' A B → (x : Box π' A) → B (unbox π' A x)
|
||||||
of {
|
of {
|
||||||
'zero ⇒ λ f x ⇒ case x return x' ⇒ B (unbox 'zero A x') of { [x] ⇒ f x };
|
'zero ⇒ λ f x ⇒ case x return x' ⇒ B (unbox0 A x') of { [x] ⇒ f x };
|
||||||
'one ⇒ λ f x ⇒ case x return x' ⇒ B (unbox 'one A x') of { [x] ⇒ f x };
|
'one ⇒ λ f x ⇒ case x return x' ⇒ B (unbox1 A x') of { [x] ⇒ f x };
|
||||||
'any ⇒ λ f x ⇒ case x return x' ⇒ B (unbox 'any A x') of { [x] ⇒ f x };
|
'any ⇒ λ f x ⇒ case x return x' ⇒ B (unboxω A x') of { [x] ⇒ f x };
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue