Mercurial > hg > Members > atton > delta_monad

comparison agda/delta/functor.agda @ 105:e6499a50ccbd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Retrying prove monad-laws for delta
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Tue, 27 Jan 2015 17:49:25 +0900
parents ebd0d6e2772c
children 0a3b6cb91a05
comparison
equal deleted inserted replaced
104:ebd0d6e2772c 105:e6499a50ccbd
1 open import Level 1 open import Level
2 open import Relation.Binary.PropositionalEquality 2 open import Relation.Binary.PropositionalEquality
3
4 3
5 open import basic 4 open import basic
6 open import delta 5 open import delta
7 open import laws 6 open import laws
8 open import nat 7 open import nat
9 open import revision
10
11
12 8
13 module delta.functor where 9 module delta.functor where
14 10
15 -- Functor-laws 11 -- Functor-laws
16 12
17 -- Functor-law-1 : T(id) = id' 13 -- Functor-law-1 : T(id) = id'
18 functor-law-1 : {l : Level} {A : Set l} {n : Rev} -> (d : Delta A n) -> (delta-fmap id) d ≡ id d 14 functor-law-1 : {l : Level} {A : Set l} {n : Nat} -> (d : Delta A (S n)) -> (delta-fmap id) d ≡ id d
19 functor-law-1 (mono x) = refl 15 functor-law-1 (mono x) = refl
20 functor-law-1 (delta x d) = cong (delta x) (functor-law-1 d) 16 functor-law-1 (delta x d) = cong (delta x) (functor-law-1 d)
21 17
22 -- Functor-law-2 : T(f . g) = T(f) . T(g) 18 -- Functor-law-2 : T(f . g) = T(f) . T(g)
23 functor-law-2 : {l : Level} {n : Rev} {A B C : Set l} -> 19 functor-law-2 : {l : Level} {n : Nat} {A B C : Set l} ->
24 (f : B -> C) -> (g : A -> B) -> (d : Delta A n) -> 20 (f : B -> C) -> (g : A -> B) -> (d : Delta A (S n)) ->
25 (delta-fmap (f ∙ g)) d ≡ ((delta-fmap f) ∙ (delta-fmap g)) d 21 (delta-fmap (f ∙ g)) d ≡ ((delta-fmap f) ∙ (delta-fmap g)) d
26 functor-law-2 f g (mono x) = refl 22 functor-law-2 f g (mono x) = refl
27 functor-law-2 f g (delta x d) = cong (delta (f (g x))) (functor-law-2 f g d) 23 functor-law-2 f g (delta x d) = cong (delta (f (g x))) (functor-law-2 f g d)
28 24
29 delta-is-functor : {l : Level} {n : Rev} -> Functor {l} (\A -> Delta A n) 25
26
27 delta-is-functor : {l : Level} {n : Nat} -> Functor {l} (\A -> Delta A (S n))
30 delta-is-functor = record { fmap = delta-fmap ; 28 delta-is-functor = record { fmap = delta-fmap ;
31 preserve-id = functor-law-1; 29 preserve-id = functor-law-1;
32 covariant = \f g -> functor-law-2 g f} 30 covariant = \f g -> functor-law-2 g f}
31
32
33 open ≡-Reasoning
34 delta-fmap-equiv : {l : Level} {A B : Set l} {n : Nat}
35 (f g : A -> B) (eq : f ≡ g) (d : Delta A (S n)) ->
36 delta-fmap f d ≡ delta-fmap g d
37 delta-fmap-equiv f g eq (mono x) = begin
38 mono (f x) ≡⟨ cong (\h -> (mono (h x))) eq ⟩
39 mono (g x) ∎
40 delta-fmap-equiv f g eq (delta x d) = begin
41 delta (f x) (delta-fmap f d) ≡⟨ cong (\h -> (delta (h x) (delta-fmap f d))) eq ⟩
42 delta (g x) (delta-fmap f d) ≡⟨ cong (\fx -> (delta (g x) fx)) (delta-fmap-equiv f g eq d) ⟩
43 delta (g x) (delta-fmap g d) ∎