home *** CD-ROM | disk | FTP | other *** search
/ back2roots/padua / padua.7z / padua / lang / gofer223.lha / demos / stateMonad < prev    next >
Encoding:
Text File  |  1992-08-14  |  2.2 KB  |  69 lines
  1. -- General purpose state monad -----------------------------------------------
  2.  
  3. type SM s a       = s -> (s, a)
  4.  
  5. -- Primitive monad operators -------------------------------------------------
  6.  
  7. return           :: a -> SM s a
  8. return x          = \s -> (s, x)
  9.  
  10. bind             :: SM s a -> (a -> SM s b) -> SM s b
  11. m `bind` f        = \s -> let (s',a) = m s in f a s'
  12.  
  13. join             :: SM s (SM s a) -> SM s a
  14. join m            = \s -> let (s',ma) = m s in ma s'
  15.  
  16. mmap             :: (a -> b) -> (SM s a -> SM s b)
  17. mmap f m          = \s -> let (s',a)  = m s in (s', f a)
  18.  
  19. -- General monad operators ---------------------------------------------------
  20.  
  21. mmapl            :: (a -> SM s b) -> ([a] -> SM s [b])
  22. mmapl f []        = return []
  23. mmapl f (a:as)    = f a             `bind` \b ->
  24.                     mmapl f as      `bind` \bs ->
  25.                     return (b:bs)
  26.  
  27. mmapr            :: (a -> SM s b) -> ([a] -> SM s [b])
  28. mmapr f []        = return []
  29. mmapr f (x:xs)    = mmapr f xs      `bind` \ys ->
  30.                     f x             `bind` \y  ->
  31.                     return (y:ys)
  32.  
  33. mfoldl           :: (a -> b -> SM s a) -> a -> [b] -> SM s a
  34. mfoldl f a []     = return a
  35. mfoldl f a (x:xs) = f a x           `bind` \fax ->
  36.                     mfoldl f fax xs
  37.  
  38. mfoldr           :: (a -> b -> SM s b) -> b -> [a] -> SM s b
  39. mfoldr f a []     = return a
  40. mfoldr f a (x:xs) = mfoldr f a xs   `bind` \y ->
  41.                     f x y
  42.  
  43. mif              :: SM s Bool -> SM s a -> SM s a -> SM s a
  44. mif c t f         = c               `bind` \cond ->
  45.                     if cond then t
  46.                             else f
  47.  
  48. -- Specific utilities for state monads ---------------------------------------
  49.  
  50. startingWith      :: SM s a -> s -> a
  51. m `startingWith` v = answer where (final,answer) = m v
  52.  
  53. fetch             :: SM s s
  54. fetch              = \s -> (s,s)
  55.  
  56. fetchWith         :: (s -> a) -> SM s a
  57. fetchWith f        = \s -> (s, f s)
  58.  
  59. update            :: (s -> s) -> SM s s
  60. update f           = \s -> (f s, s)
  61.  
  62. set               :: s -> SM s s
  63. set s'             = \s -> (s',s)
  64.  
  65. -- Common use of state monad: counter ----------------------------------------
  66.  
  67. incr              :: SM Int Int
  68. incr               = update (1+)
  69.