View plain source

  1. // Chris Done
  2. // Created: 13 April, 2008
  3. // Last modified: 13 April, 2008
  4. /* State monad in Haskell */
  5.  
  6. // Simple tuple
  7. function tuple(x,y) { return function(f) { return f(x,y); } }
  8. function fst(t) { return t(function(x,y) { return x; }); }
  9. function snd(t) { return t(function(x,y) { return y; }); }
  10.  
  11. // Monadic operations
  12.  
  13. // Equivalent to >>=
  14. function bindM(m ,k)
  15. {
  16.     return function (s) {
  17.         tmp = m(s);
  18.         a = fst(tmp); s_ = snd(tmp);
  19.         return k(a)(s_);
  20.     }
  21. }
  22.  
  23. // Equivalent to >>
  24. function thenM(m,k) {
  25.     return bindM(m,function(_){return k;});
  26. }
  27.  
  28. function returnM(v) {
  29.     return function (s) {
  30.         return tuple(v,s);
  31.     }
  32. }
  33.  
  34. function evalS(m,s) {
  35.     return fst(m(s));
  36. }
  37.  
  38. function getS(s) {
  39.     return tuple(s,s);
  40. }
  41.  
  42. function putS(s) {
  43.     return function(_) {
  44.         return tuple(null,s);
  45.     }
  46. }
  47.  
  48. /* Simple examples: */
  49. function print(s) { document.write("<p>" + s + "</p>"); }
  50.  
  51. print(
  52.       evalS(
  53.             thenM( putS("Woo!") , bindM( getS , returnM ) )
  54.             ,2));
  55. // Output: "Woo!"
  56.  
  57. print(
  58.       evalS(
  59.             thenM( putS("Woo!") , getS )
  60.             ,2));
  61. // Output: "Woo!"
  62.  
  63. print(
  64.     evalS(
  65.         thenM( bindM( getS , function(n) { return putS(n+1); } )
  66.              , getS
  67.              )
  68.         ,1));