1 module StateMonad where 2 3 -- General purpose state monad ----------------------------------------------- 4 5 type SM s a = s -> (s, a) 6 7 -- Primitive monad operators ------------------------------------------------- 8 9 retURN :: a -> SM s a 10 retURN x = \s -> (s, x) 11 12 bind :: SM s a -> (a -> SM s b) -> SM s b 13 m `bind` f = \s -> let (s',a) = m s in f a s' 14 15 join :: SM s (SM s a) -> SM s a 16 join m = \s -> let (s',ma) = m s in ma s' 17 18 mmap :: (a -> b) -> (SM s a -> SM s b) 19 mmap f m = \s -> let (s',a) = m s in (s', f a) 20 21 -- General monad operators --------------------------------------------------- 22 23 mmapl :: (a -> SM s b) -> ([a] -> SM s [b]) 24 mmapl f [] = retURN [] 25 mmapl f (a:as) = f a `bind` \b -> 26 mmapl f as `bind` \bs -> 27 retURN (b:bs) 28 29 mmapr :: (a -> SM s b) -> ([a] -> SM s [b]) 30 mmapr f [] = retURN [] 31 mmapr f (x:xs) = mmapr f xs `bind` \ys -> 32 f x `bind` \y -> 33 retURN (y:ys) 34 35 mfoldl :: (a -> b -> SM s a) -> a -> [b] -> SM s a 36 mfoldl f a [] = retURN a 37 mfoldl f a (x:xs) = f a x `bind` \fax -> 38 mfoldl f fax xs 39 40 mfoldr :: (a -> b -> SM s b) -> b -> [a] -> SM s b 41 mfoldr f a [] = retURN a 42 mfoldr f a (x:xs) = mfoldr f a xs `bind` \y -> 43 f x y 44 45 mif :: SM s Bool -> SM s a -> SM s a -> SM s a 46 mif c t f = c `bind` \cond -> 47 if cond then t 48 else f 49 50 -- Specific utilities for state monads --------------------------------------- 51 52 startingWith :: SM s a -> s -> a 53 m `startingWith` v = answer where (final,answer) = m v 54 55 fetch :: SM s s 56 fetch = \s -> (s,s) 57 58 fetchWith :: (s -> a) -> SM s a 59 fetchWith f = \s -> (s, f s) 60 61 update :: (s -> s) -> SM s s 62 update f = \s -> (f s, s) 63 64 set :: s -> SM s s 65 set s' = \s -> (s',s) 66 67 -- Common use of state monad: counter ---------------------------------------- 68 69 incr :: SM Int Int 70 incr = update (1+)