2
module InductiveAndCoinductiveConstructors where
4
open import Common.Coinduction
8
data _×_ (A : Set) (B : Set) : Set where
9
_,_ : (x : A) (y : B) → A × B
11
data Stream (A : Set) : Set where
12
_≺_ : (x : A) (xs : ∞ (Stream A)) → Stream A
20
El (stream a) = Stream (El a)
21
El (a ⊗ b) = El a × El b
26
data WHNF : U → Set where
27
_≺_ : ∀ {a} → El a → Prog (stream a) → WHNF (stream a)
28
_,_ : ∀ {a b} → WHNF a → WHNF b → WHNF (a ⊗ b)
30
data Prog : U → Set where
31
↓_ : ∀ {a} → ∞ (WHNF a) → Prog a
32
fst : ∀ {a b} → Prog (a ⊗ b) → Prog a
33
snd : ∀ {a b} → Prog (a ⊗ b) → Prog b
34
lab : Prog (stream unit) → Prog (stream (stream unit)) →
35
Prog (stream unit ⊗ stream (stream unit))
37
whnf : ∀ {a} → Prog a → WHNF a
39
whnf (fst p) with whnf p
41
whnf (snd p) with whnf p
43
whnf (lab xs lss) with whnf xs | whnf lss
44
... | _ ≺ xs′ | (x ≺ ls) ≺ lss′ =
45
((_ ≺ fst (lab xs′ lss′)) , (♭ ls ≺ snd (lab xs′ lss′)))
47
⟦_⟧ : Prog (stream unit) → Stream ⊤
49
... | x ≺ xs = x ≺ ♯ ⟦ xs ⟧
51
data _≈_ : Stream ⊤ → Stream ⊤ → Set where
52
cons : ∀ {xs xs′} → ∞ ((♭ xs) ≈ (♭ xs′)) → (_ ≺ xs) ≈ (_ ≺ xs′)
54
lemma : ∀ xs lss → ⟦ fst (lab xs lss) ⟧ ≈ ⟦ xs ⟧
55
lemma xs lss with whnf xs | whnf lss
56
... | _ ≺ xs′ | (x ≺ ls) ≺ lss′ = cons (♯ lemma xs′ lss′)
58
{- Andreas, 2012-09-07 WAS:
59
label : Prog (stream unit) → Stream ⊤ →
60
Prog (stream unit ⊗ stream (stream unit))
61
label xs ls = lab xs (↓ (♯ (ls ≺ snd (label xs ls))))
63
shape-preserved : ∀ xs ls → ⟦ fst (label xs ls) ⟧ ≈ ⟦ xs ⟧
64
shape-preserved xs ls = lemma xs _
68
label : Prog (stream unit) → Stream ⊤ →
69
Prog (stream unit ⊗ stream (stream unit))
70
label xs ls = lab xs (lss xs ls)
72
lss : Prog (stream unit) → Stream ⊤ → _
73
lss xs ls = (↓ (♯ (ls ≺ snd (label xs ls))))
75
shape-preserved : ∀ xs ls → ⟦ fst (label xs ls) ⟧ ≈ ⟦ xs ⟧
76
shape-preserved xs ls = lemma xs (lss xs ls)