evandrix

[c++] monad

Jul 13th, 2011
360
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. /* g++-mp-4.5 -Wall -pedantic -std=c++0x -g -ggdb -I/opt/local/include -L/opt/local/lib -static-libstdc++ monads.cpp -o monads */
  2. #include <iostream>
  3. #include <functional>
  4.  
  5. template<int n> struct Const {};
  6. template<class E1, class E2> struct Plus {};
  7. template<class E1, class E2> struct Times {};
  8. struct Arg1 {};
  9. struct Arg2 {};
  10.  
  11. // type Args = [Integer]
  12. struct Args
  13. {
  14.     Args(int i, int j) {
  15.         _a[0] = i;
  16.         _a[1] = j;
  17.     }
  18.     int operator[](int n) { return _a[n]; }
  19.     int _a[2];
  20. };
  21. /* in Haskell:
  22.     getArg :: Int -> Prog Int
  23.     getArg n = PR (λ args -> args !! n)
  24. */
  25. template<int n> struct GetArg { // instance of the concept PR
  26.     int operator()(Args args) {
  27.         return args[n];
  28.     }
  29. };
  30.  
  31. /* Haskell's implementation of monadic bind
  32.     bind (PR prog) cont =
  33.         PR (λ args ->
  34.             let v = prog args
  35.                 (PR prog') = cont v
  36.             in
  37.                 prog' args)
  38. */
  39. template<class P1, class P2>    // compile-time type parameters
  40. struct Bind
  41. {
  42.     Bind(P1 prog, std::function<P2(int)> cont)
  43.         : _prog(prog), _cont(cont) {}
  44.  
  45.     int operator()(Args args) {
  46.         int v = _prog(args);
  47.         P2 prog2 = _cont(v);
  48.         return prog2(args);
  49.     }
  50.  
  51.     P1 _prog;
  52.     // store a lambda continuation
  53.     std::function<P2(int)> _cont;
  54. };
  55.  
  56. /* in Haskell:
  57.     return :: a -> Prog a
  58.     return v = PR (λ args -> v)
  59. */
  60. struct Return
  61. {
  62.     Return(int v) : _v(v) {}
  63.     int operator()(Args args)
  64.     {
  65.         return _v;
  66.     }
  67.     int _v;
  68. };
  69.  
  70. // compile :: Exp -> Prog Int
  71. template<class Exp>
  72. struct Compile;
  73.  
  74. // compile (Const c) = return c
  75. template<int c>
  76. struct Compile<Const<c> > : Return
  77. {
  78.     Compile() : Return(c) {}
  79. };
  80.  
  81. // compile Arg1 = getArg 0
  82. template<>
  83. struct Compile<Arg1> : GetArg<0> {};
  84.  
  85. // compile Arg2 = getArg 1
  86. template<>
  87. struct Compile<Arg2> : GetArg<1> {};
  88.  
  89. /* in Haskell:
  90.     compile (Plus exL exR) =
  91.       bind compile exL
  92.            λ left ->
  93.               bind compile exR
  94.                    λ right ->
  95.                        return (left + right)
  96. */
  97. template<class L, class R>
  98. struct Compile<Plus<L, R> > {
  99.   int operator()(Args args)
  100.   {
  101.     return Bind<Compile<L>, Bind<Compile<R>, Return> > (
  102.       Compile<L>(),
  103.       [](int left) -> Bind<Compile<R>, Return> {
  104.         return Bind<Compile<R>, Return>(
  105.           Compile<R>(),
  106.           [left](int right) -> Return {
  107.             return Return(left + right);
  108.           }
  109.         );
  110.       }
  111.     )(args);
  112.   }
  113. };
  114.  
  115. template<class L, class R>
  116. struct Compile<Times<L, R> > {
  117.   int operator()(Args args)
  118.   {
  119.     return Bind<Compile<L>, Bind<Compile<R>, Return> > (
  120.       Compile<L>(),
  121.       [](int left) -> Bind<Compile<R>, Return> {
  122.         return Bind<Compile<R>, Return>(
  123.           Compile<R>(),
  124.           [left](int right) -> Return {
  125.             return Return(left * right);
  126.           }
  127.         );
  128.       }
  129.     )(args);
  130.   }
  131. };
  132.  
  133. int main(void) {
  134.     Args args(3, 4);
  135.     Compile<Plus<Times<Arg1, Arg2>, Const<13> > > act;
  136.     int v = act(args);
  137.     std::cout << v << std::endl;
  138.     return 0;
  139. }
RAW Paste Data