Mercurial > hg > Members > atton > agda-proofs
changeset 14:31b1b7cc43cd
Prove state is functor
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 03 May 2016 16:31:56 +0900 |
parents | 14c22339ce06 |
children | d924de5deb70 62dfa11a8629 |
files | state/state.agda |
diffstat | 1 files changed, 38 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/state/state.agda Tue May 03 16:01:54 2016 +0900 +++ b/state/state.agda Tue May 03 16:31:56 2016 +0900 @@ -2,6 +2,24 @@ open import Level open ≡-Reasoning + +module state where + +record Product {l : Level} (A B : Set l) : Set (suc l) where + constructor <_,_> + field + first : A + second : B +open Product + +id : {l : Level} {A : Set l} -> A -> A +id a = a + + +infixr 10 _∘_ +_∘_ : {l : Level} {A B C : Set l} -> (B -> C) -> (A -> B) -> (A -> C) +g ∘ f = \a -> g (f a) + {- Haskell Definition newtype State s a = State { runState :: s -> (a, s) } @@ -13,14 +31,6 @@ in runState (k a) s' -} -module state where - -record Product {l : Level} (A B : Set l) : Set (suc l) where - constructor <_,_> - field - first : A - second : B -open Product record State {l : Level} (S A : Set l) : Set (suc l) where field @@ -30,8 +40,26 @@ state : {l : Level} {S A : Set l} -> (S -> Product A S) -> State S A state f = record {runState = f} -return : {l : Level} {S A : Set l} -> A -> State S A +return : {l : Level} {S A : Set l} -> A -> State S A return a = state (\s -> < a , s > ) _>>=_ : {l : Level} {S A B : Set l} -> State S A -> (A -> State S B) -> State S B -m >>= k = state (\s -> (State.runState (k (Product.first (State.runState m s))) (Product.second (State.runState m s)))) \ No newline at end of file +m >>= k = state (\s -> (runState (k (first (runState m s))) (second (runState m s)))) + +{- fmap definitions in Haskell +instance Functor (State s) where + fmap f m = State $ \s -> let + (a, s') = runState m s + in (f a, s') +-} + +fmap : {l : Level} {S A B : Set l} -> (A -> B) -> (State S A) -> (State S B) +fmap f m = state (\s -> < (f (first ((runState m) s))), (second ((runState m) s)) >) + +-- proofs + +fmap-id : {l : Level} {A S : Set l} {s : State S A} -> fmap id s ≡ id s +fmap-id = refl + +fmap-comp : {l : Level} {S A B C : Set l} {g : B -> C} {f : A -> B} {s : State S A} -> ((fmap g) ∘ (fmap f)) s ≡ fmap (g ∘ f) s +fmap-comp {_}{_}{_}{_}{_}{g}{f}{s} = refl