157 lines
4.6 KiB
Plaintext
157 lines
4.6 KiB
Plaintext
load "misc.quox"
|
||
|
||
def0 Qty : ★ = {"zero", one, any}
|
||
|
||
def0 NzQty : ★ = {one, any}
|
||
|
||
def nz : NzQty → Qty =
|
||
λ π ⇒ case π return Qty of { 'one ⇒ 'one; 'any ⇒ 'any }
|
||
|
||
def dup! : (π : Qty) → Dup Qty π =
|
||
λ π ⇒ case π return π' ⇒ Dup Qty π' of {
|
||
'zero ⇒ (['zero], [δ _ ⇒ ['zero]]);
|
||
'one ⇒ (['one], [δ _ ⇒ ['one]]);
|
||
'any ⇒ (['any], [δ _ ⇒ ['any]]);
|
||
}
|
||
|
||
def dup : (π : Qty) → [ω.Qty] =
|
||
λ π ⇒ dup.valω Qty π (dup! π)
|
||
|
||
def drop : 0.(A : ★) → Qty → A → A =
|
||
λ A π x ⇒ case π return A of {
|
||
'zero ⇒ x;
|
||
'one ⇒ x;
|
||
'any ⇒ x;
|
||
}
|
||
|
||
def if-zero : 0.(A : ★) → Qty → ω.A → ω.A → A =
|
||
λ A π z nz ⇒
|
||
case π return A of { 'zero ⇒ z; 'one ⇒ nz; 'any ⇒ nz }
|
||
|
||
def plus : Qty → ω.Qty → Qty =
|
||
λ π ρ ⇒
|
||
case π return Qty of {
|
||
'zero ⇒ ρ;
|
||
'one ⇒ if-zero Qty ρ 'one 'any;
|
||
'any ⇒ 'any;
|
||
}
|
||
|
||
def times : Qty → ω.Qty → Qty =
|
||
λ π ρ ⇒
|
||
case π return Qty of {
|
||
'zero ⇒ 'zero;
|
||
'one ⇒ ρ;
|
||
'any ⇒ if-zero Qty ρ 'zero 'any;
|
||
}
|
||
|
||
def0 FUN : Qty → (A : ★) → (A → ★) → ★ =
|
||
λ π A B ⇒
|
||
case π return ★ of {
|
||
'zero ⇒ 0.(x : A) → B x;
|
||
'one ⇒ 1.(x : A) → B x;
|
||
'any ⇒ ω.(x : A) → B x;
|
||
}
|
||
|
||
def0 FUN-NZ : NzQty → (A : ★) → (A → ★) → ★ =
|
||
λ π A B ⇒
|
||
case π return ★ of {
|
||
'one ⇒ 1.(x : A) → B x;
|
||
'any ⇒ ω.(x : A) → B x;
|
||
}
|
||
|
||
def0 Fun : Qty → ★ → ★ → ★ =
|
||
λ π A B ⇒ FUN π A (λ _ ⇒ B)
|
||
|
||
def0 FunNz : NzQty → ★ → ★ → ★ =
|
||
λ π A B ⇒ FUN-NZ π A (λ _ ⇒ B)
|
||
|
||
def0 Box : Qty → ★ → ★ =
|
||
λ π A ⇒
|
||
case π return ★ of {
|
||
'zero ⇒ [0.A];
|
||
'one ⇒ [1.A];
|
||
'any ⇒ [ω.A];
|
||
}
|
||
|
||
def0 BoxNz : NzQty → ★ → ★ =
|
||
λ π A ⇒
|
||
case π return ★ of {
|
||
'one ⇒ [1.A];
|
||
'any ⇒ [ω.A];
|
||
}
|
||
|
||
def0 unbox : (π : Qty) → (A : ★) → Box π A → A =
|
||
λ π A ⇒
|
||
case π return π' ⇒ Box π' A → A of {
|
||
'zero ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
|
||
'one ⇒ λ 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
|
||
|
||
def0 unbox-nz : (π : NzQty) → (A : ★) → BoxNz π A → A =
|
||
λ π A ⇒
|
||
case π return π' ⇒ BoxNz π' A → A of {
|
||
'one ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
|
||
'any ⇒ λ x ⇒ case x return A of { [x] ⇒ x };
|
||
}
|
||
|
||
def0 unbox-nz1 = unbox-nz 'one
|
||
def0 unbox-nzω = unbox-nz 'any
|
||
|
||
def apply : (π : Qty) → 0.(A : ★) → 0.(B : A → ★) →
|
||
FUN π A B → (x : Box π A) → B (unbox π A x) =
|
||
λ π A B ⇒
|
||
case π
|
||
return π' ⇒ FUN π' A B → (x : Box π' A) → B (unbox π' A x)
|
||
of {
|
||
'zero ⇒ λ f x ⇒ case x return x' ⇒ B (unbox0 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ω A x') of { [x] ⇒ f x };
|
||
}
|
||
|
||
def apply' : (π : Qty) → 0.(A B : ★) → Fun π A B → (x : Box π A) → B =
|
||
λ π A B ⇒ apply π A (λ _ ⇒ B)
|
||
|
||
def apply-nz : (π : NzQty) → 0.(A : ★) → 0.(B : A → ★) →
|
||
FUN-NZ π A B → (x : BoxNz π A) → B (unbox-nz π A x) =
|
||
λ π A B ⇒
|
||
case π
|
||
return π' ⇒ FUN-NZ π' A B → (x : BoxNz π' A) → B (unbox-nz π' A x)
|
||
of {
|
||
'one ⇒ λ f x ⇒ case x return x' ⇒ B (unbox-nz1 A x') of { [x] ⇒ f x };
|
||
'any ⇒ λ f x ⇒ case x return x' ⇒ B (unbox-nzω A x') of { [x] ⇒ f x };
|
||
}
|
||
|
||
def apply-nz' : (π : NzQty) → 0.(A B : ★) → FunNz π A B → (x : BoxNz π A) → B =
|
||
λ π A B ⇒ apply-nz π A (λ _ ⇒ B)
|
||
|
||
def lam : (π : Qty) → 0.(A : ★) → 0.(B : A → ★) →
|
||
((x : Box π A) → B (unbox π A x)) → FUN π A B =
|
||
λ π A B ⇒
|
||
case π
|
||
return π' ⇒ ((x : Box π' A) → B (unbox π' A x)) → FUN π' A B of {
|
||
'zero ⇒ λ f x ⇒ f [x];
|
||
'one ⇒ λ f x ⇒ f [x];
|
||
'any ⇒ λ f x ⇒ f [x];
|
||
}
|
||
|
||
def lam' : (π : Qty) → 0.(A B : ★) → (Box π A → B) → Fun π A B =
|
||
λ π A B ⇒ lam π A (λ _ ⇒ B)
|
||
|
||
def lam-nz : (π : NzQty) → 0.(A : ★) → 0.(B : A → ★) →
|
||
((x : BoxNz π A) → B (unbox-nz π A x)) → FUN-NZ π A B =
|
||
λ π A B ⇒
|
||
case π
|
||
return π' ⇒ ((x : BoxNz π' A) → B (unbox-nz π' A x)) → FUN-NZ π' A B of {
|
||
'one ⇒ λ f x ⇒ f [x];
|
||
'any ⇒ λ f x ⇒ f [x];
|
||
}
|
||
|
||
def lam-nz' : (π : NzQty) → 0.(A B : ★) → (BoxNz π A → B) → FunNz π A B =
|
||
λ π A B ⇒ lam-nz π A (λ _ ⇒ B)
|
||
|