Update 'agda w type stuff'
parent
3d5bb7e556
commit
79370a6058
1 changed files with 51 additions and 45 deletions
|
|
@ -7,13 +7,12 @@ open import Data.Container.Relation.Unary.All
|
|||
open import Data.W
|
||||
open import Data.Empty
|
||||
open import Data.Unit
|
||||
open import Relation.Nullary
|
||||
open import Data.Product renaming (proj₁ to fst; proj₂ to snd)
|
||||
open import Data.Product
|
||||
open import Relation.Binary.PropositionalEquality
|
||||
|
||||
variable A B : Set
|
||||
|
||||
postulate ⊥-funext : {f g : ⊥ → B} → f ≡ g
|
||||
postulate ⊥-funext : (f : ⊥ → B) → f ≡ λ ()
|
||||
```
|
||||
|
||||
# ℕ
|
||||
|
|
@ -38,12 +37,15 @@ module Nat where
|
|||
elim : (P : Nat → Set) →
|
||||
P zero → (∀ {n} → P n → P (suc n)) →
|
||||
∀ n → P n
|
||||
elim P pz ps = induction P λ where
|
||||
{#zero , _} (all ih) → subst (λ f → P (sup (#zero , f))) ⊥-funext pz
|
||||
{#suc , n} (all ih) → ps (ih tt)
|
||||
elim P pz ps = induction P $ p _ where
|
||||
p : ∀ t → □ (Tag ▷ Child) P t → P (sup t)
|
||||
p (#zero , f) _ rewrite ⊥-funext f = pz
|
||||
p (#suc , _) (all ih) = ps $ ih _
|
||||
```
|
||||
|
||||
# List
|
||||
# list
|
||||
|
||||
non recursive arguments can be put in `A`.
|
||||
|
||||
```agda
|
||||
module List where
|
||||
|
|
@ -57,8 +59,11 @@ module List where
|
|||
Child #nil = ⊥
|
||||
Child #cons = ⊤
|
||||
|
||||
Body : Set → Set
|
||||
Body A = Σ[ t ∈ Tag ] (Field A t)
|
||||
|
||||
List : Set → Set
|
||||
List A = W (Σ Tag (Field A) ▷ Child ∘ fst)
|
||||
List A = W (Body A ▷ Child ∘ proj₁)
|
||||
|
||||
nil : List A
|
||||
nil = sup ((#nil , tt) , λ ())
|
||||
|
|
@ -68,16 +73,17 @@ module List where
|
|||
x ∷ xs = sup ((#cons , x) , const xs)
|
||||
|
||||
elim : (P : List A → Set) →
|
||||
(pn : P nil) →
|
||||
(pc : (x : A) {xs : List A} → P xs → P (x ∷ xs)) →
|
||||
P nil → (∀ x {xs} → P xs → P (x ∷ xs)) →
|
||||
∀ xs → P xs
|
||||
elim P pn pc = induction P $ λ where
|
||||
{(#nil , tt) , rec} _ →
|
||||
subst (λ f → P (sup ((#nil , tt) , f))) ⊥-funext pn
|
||||
{(#cons , x) , xs′} (all ih) → pc x (ih tt)
|
||||
elim {A} P pn pc = induction P $ p _ where
|
||||
p : ∀ t → □ (Body A ▷ Child ∘ proj₁) P t → P (sup t)
|
||||
p ((#nil , _) , f) (all ih) rewrite ⊥-funext f = pn
|
||||
p ((#cons , x) , f) (all ih) = pc x (ih _)
|
||||
```
|
||||
|
||||
# indexed w
|
||||
# indexed w-types
|
||||
|
||||
see e.g. <https://github.com/jashug/IWTypes>
|
||||
|
||||
```agda
|
||||
record Desc : Set₁ where
|
||||
|
|
@ -89,7 +95,7 @@ record Desc : Set₁ where
|
|||
child : ∀ {T} → Child T → Index
|
||||
|
||||
module IndexedW (𝒟 : Desc) where
|
||||
open Desc 𝒟
|
||||
open Desc 𝒟 public
|
||||
|
||||
T′ : Set
|
||||
T′ = W (Tag ▷ Child)
|
||||
|
|
@ -102,54 +108,54 @@ module IndexedW (𝒟 : Desc) where
|
|||
T 𝑖 = Σ[ x ∈ T′ ] (wf x 𝑖)
|
||||
|
||||
isup : (t : Tag) (f : (c : Child t) → T (child c)) → T (this t)
|
||||
isup t f = sup (t , fst ∘ f) , refl , snd ∘ f
|
||||
isup t f = sup (t , proj₁ ∘ f) , refl , proj₂ ∘ f
|
||||
|
||||
module _ (P : ∀ {i} → T i → Set)
|
||||
(s : ∀ t f → (∀ c → P (f c)) → P (isup t f)) where
|
||||
iinduction′ : ∀ {𝑖} t (p : wf t 𝑖) → P (t , p)
|
||||
iinduction′ t p =
|
||||
induction (λ t → ∀ {𝑖} (p : wf t 𝑖) → P (t , p))
|
||||
(λ where
|
||||
{t , f} (all ih) (refl , eq-ih) →
|
||||
s t (λ c → f c , eq-ih c)
|
||||
(λ c → ih c (eq-ih c)))
|
||||
t p
|
||||
iinduction : (P : ∀ {𝑖} → T 𝑖 → Set)
|
||||
(s : ∀ t f → (∀ c → P (f c)) → P (isup t f)) →
|
||||
∀ {𝑖} (t : T 𝑖) → P t
|
||||
iinduction P s (t , φ) = induction P′ (p _) t φ where
|
||||
P′ : T′ → Set
|
||||
P′ t = ∀ {𝑖} (φ : wf t 𝑖) → P (t , φ)
|
||||
|
||||
iinduction : ∀ {𝑖} (x : T 𝑖) → P x
|
||||
iinduction (t , p) = iinduction′ t p
|
||||
p : ∀ t → □ (Tag ▷ Child) P′ t → ∀ {𝑖} φ → P (sup t , φ)
|
||||
p (t , f) (all ih) (refl , φ′) =
|
||||
s t (λ c → f c , φ′ c) (λ c → ih c (φ′ c))
|
||||
```
|
||||
|
||||
# fin (indexed)
|
||||
# fin
|
||||
|
||||
the elim doesn't actually compute properly because `⊥-funext` gets
|
||||
stuck. oh well. not a problem for quox >:3
|
||||
|
||||
```agda
|
||||
module Fin where
|
||||
open Nat public using (Nat; #zero; #suc)
|
||||
renaming (zero to nzero; suc to nsuc)
|
||||
|
||||
desc : Desc
|
||||
desc = let open Desc in λ where
|
||||
.Index → Nat
|
||||
.Tag → Nat.Tag × Nat
|
||||
.Child (t , _) → Nat.Child t
|
||||
.this (_ , n) → Nat.suc n
|
||||
.child {_ , n} c → n
|
||||
module FinW =
|
||||
IndexedW (let open Desc in λ where
|
||||
.Index → Nat
|
||||
.Tag → Nat.Tag × Nat
|
||||
.Child (t , _) → Nat.Child t
|
||||
.this (_ , n) → Nat.suc n
|
||||
.child {_ , n} c → n)
|
||||
|
||||
open module Fin-W = IndexedW desc using (iinduction; isup)
|
||||
open Fin-W public using () renaming (T to Fin)
|
||||
Fin = FinW.T
|
||||
|
||||
private variable n : Nat
|
||||
|
||||
zero : Fin (nsuc n)
|
||||
zero {n} = (sup ((#zero , n) , λ ())) , refl , λ ()
|
||||
zero = FinW.isup (#zero , _) (λ ())
|
||||
|
||||
suc : Fin n → Fin (nsuc n)
|
||||
suc {n} (i , p) = (sup ((#suc , n) , const i)) , refl , const p
|
||||
suc i = FinW.isup (#suc , _) (const i)
|
||||
|
||||
elim : (P : ∀ {n} → Fin n → Set) →
|
||||
(∀ {n} → P (zero {n})) →
|
||||
(∀ {n} (i : Fin n) → P i → P (suc i)) →
|
||||
(i : Fin n) → P i
|
||||
elim P pz ps = iinduction P λ where
|
||||
(#zero , n) f _ → subst (λ f → P (isup (#zero , n) f)) ⊥-funext pz
|
||||
(#suc , n) f ih → ps (f tt) (ih tt)
|
||||
```
|
||||
elim P pz ps = FinW.iinduction P p where
|
||||
p : ∀ t f → (∀ c → P (f c)) → P (FinW.isup t f)
|
||||
p (#zero , n) f ih rewrite ⊥-funext f = pz
|
||||
p (#suc , n) f ih = ps (f _) (ih _)
|
||||
```
|
||||
|
|
|
|||
Loading…
Reference in a new issue