quox/quox-nat.agda

79 lines
1.8 KiB
Agda
Raw Normal View History

open import Axiom.Extensionality.Propositional
module _ (ext : {a b} Extensionality a b) where
open import Prelude hiding (zero; suc)
2022-04-06 14:21:02 -04:00
open import Data.W renaming (induction to induction)
open import Data.Container
open import Data.Container.Relation.Unary.All ; open
2022-04-06 14:21:02 -04:00
variable
𝓀 : Level
A B : Set 𝓀
P Q : A Set
C : Container 𝓀
data Tag : Set where `zero `suc : Tag
Body : Tag Set
Body t = case t of λ {`zero ; `suc }
Repr : Container lzero lzero
Repr = Tag Body
Nat : Set
Nat = W Repr
Nat : Set
Nat = Repr Nat
zero : Nat
zero = sup (`zero , λ ())
suc : Nat Nat
suc n = sup (`suc , const n)
2022-04-06 14:21:02 -04:00
induction :
(P : W C Set )
(IH : (t : C (W C)) C P t P (sup t))
(w : W C) P w
induction P IH = induction P (λ {t} IH t)
elim : (P : Nat Set )
(Z : P zero)
(S : n P n P (suc n))
(n : Nat) P n
2022-04-06 14:21:02 -04:00
elim P Z S = induction _ λ (tag , body)
body |>
(case tag
return (λ t (n : Body t Nat)
Repr P (t , n)
P (sup (t , n)))
of λ where
`zero λ n _ ≡.subst (λ n P (sup (`zero , n))) (ext λ ()) Z
2022-04-06 14:21:02 -04:00
`suc λ n IH S (n tt) (IH .proof tt))
pred : Nat Nat
pred = induction _ λ n@(tag , body) _
body |>
(case tag
return (λ t (Body t Nat) Nat)
of λ where
`zero _ zero
`suc n n tt)
Subterms : (A : Set 𝓀) (P : A Set ) Set _
Subterms A P = Σ[ x A ] (P x W (A P))
subterms : W (A P) Subterms A P
subterms = induction _ λ t IH t
natSub : Nat List Nat
natSub n =
case subterms n of λ where
(`zero , body) []
(`suc , body) [ body tt ]
where open List