├── Advanced
    ├── Advanced.cpp
    ├── List.h
    ├── RBMap.h
    └── StateList.h
├── Calc
    ├── Calc.cpp
    └── List.h
├── Full
    ├── List.h
    ├── MoreMoney.cpp
    └── StateList.h
├── Haskell
    ├── Advanced.hs
    ├── Calc.hs
    ├── Main.hs
    └── Solver.hs
├── README.md
├── Scala
    ├── build.sbt
    └── src
    │   └── main
    │       └── scala
    │           └── SendMoreMoney.scala
├── Simple
    ├── List.h
    ├── MoreMoney.cpp
    └── StateList.h
└── StateMonad
    ├── List.h
    └── State.cpp


/Advanced/Advanced.cpp:
--------------------------------------------------------------------------------
  1 | #include "StateList.h"
  2 | #include "RBMap.h"
  3 | #include <vector>
  4 | #include <string>
  5 | #include <algorithm>
  6 | 
  7 | using namespace std;
  8 | 
  9 | // select ::[a] ->[(a, [a])]
 10 | // select[] = []
 11 | // select(x:xs) = (x, xs) : [(y, x:ys) | (y, ys) <-select xs]
 12 | 
 13 | template<class A>
 14 | PairList<A> select(List<A> lst)
 15 | {
 16 |     if (lst.isEmpty())
 17 |         return PairList<A>();
 18 | 
 19 |     A       x = lst.front();
 20 |     List<A> xs = lst.popped_front();
 21 | 
 22 |     auto result = List<pair<A, State>>();
 23 |     forEach(select(xs), [x, &result](pair<A, List<A>> const & p)
 24 |     {
 25 |         A       y = p.first;
 26 |         List<A> ys = p.second;
 27 |         auto y_xys = make_pair(y, ys.pushed_front(x));
 28 |         result = result.pushed_front(y_xys);
 29 |     });
 30 | 
 31 |     return result.pushed_front(make_pair(x, xs));
 32 | }
 33 | 
 34 | int asNumber(vector<int> const & v)
 35 | {
 36 |     int acc = 0;
 37 |     for (auto i : v)
 38 |     {
 39 |         acc = 10 * acc + i;
 40 |     }
 41 |     return acc;
 42 | }
 43 | 
 44 | using Map = RBMap<char, int>;
 45 | 
 46 | int get(Map const & subst, char c)
 47 | {
 48 |     return subst.findWithDefault(-1, c);
 49 | }
 50 | 
 51 | int toNumber(Map const & subst, string const & str)
 52 | {
 53 |     int acc = 0;
 54 |     for (char c : str)
 55 |     {
 56 |         int d = get(subst, c);
 57 |         acc = 10 * acc + d;
 58 |     }
 59 |     return acc;
 60 | }
 61 | 
 62 | // eliminate all duplicate characters
 63 | string nub(string const & str)
 64 | {
 65 |     string result;
 66 |     for (char c : str)
 67 |     {
 68 |         if (result.find(c) == string::npos)
 69 |             result.push_back(c);
 70 |     }
 71 |     return result;
 72 | }
 73 | 
 74 | /*
 75 | solve :: StateList [Int] (Int, Int, Int)
 76 | solve = StateList select >>= go (nub "sendmoremoney") M.empty
 77 |   where
 78 |     go [c] subst i = prune (M.insert c i subst)
 79 |     go (c:cs) subst i = StateList select >>= go cs (M.insert c i subst)
 80 |     prune subst = do
 81 |         guard (get 's' /= 0 && get 'm' /= 0)
 82 |         let send  = toNumber "send"
 83 |             more  = toNumber "more"
 84 |             money = toNumber "money"
 85 |         guard $ send + more == money
 86 |         return (send, more, money)
 87 |       where
 88 |         get c = fromJust (M.lookup c subst)
 89 |         toNumber str = asNumber (map get str)
 90 |         asNumber = foldl (\t o -> t*10 + o) 0
 91 | */
 92 | 
 93 | StateList<tuple<int, int, int>> prune(Map subst)
 94 | {
 95 |     return mthen(guard(get(subst, 's') != 0 && get(subst, 'm') != 0), [=]() {
 96 |         int send = toNumber(subst, "send");
 97 |         int more = toNumber(subst, "more");
 98 |         int money = toNumber(subst, "money");
 99 |         return mthen(guard(send + more == money), [=]() {
100 |             return mreturn(make_tuple(send, more, money));
101 |         });
102 |     });
103 | }
104 | 
105 | // go[c] subst i = prune(M.insert c i subst)
106 | // go(c:cs) subst i = StateList select >>= go cs(M.insert c i subst)
107 | StateList<tuple<int, int, int>> go(string str, Map subst, int i)
108 | {
109 |     StateList<int> sel = &select<int>;
110 | 
111 |     assert(str.length() > 0);
112 |     if (str.length() == 1)
113 |         return prune(subst.inserted(str[0], i));
114 |     else
115 |     {
116 |         return mbind(sel, [=](int n) {
117 |             string tail(&str[1], &str[str.length()]);
118 |             return go(tail, subst.inserted(str[0], i), n);
119 |         });
120 |     }
121 | }
122 | 
123 | // solve = StateList select >>= go (nub "sendmoremoney") M.empty
124 | 
125 | StateList<tuple<int, int, int>> solve()
126 | {
127 |     StateList<int> sel = &select<int>;
128 |     Map subst;
129 |     return mbind(sel, [=](int s) {
130 |         return go(nub("sendmoremoney"), subst, s);
131 |     });
132 | }
133 | 
134 | int main()
135 | {
136 |     List<int> lst{ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 };
137 |     cout << evalStateList(solve(), lst);
138 |     return 0;
139 | }


--------------------------------------------------------------------------------
/Advanced/List.h:
--------------------------------------------------------------------------------
  1 | #if ! defined(LIST_H)
  2 | #define LIST_H
  3 | 
  4 | #include <cassert>
  5 | #include <memory>
  6 | #include <functional>
  7 | #include <initializer_list>
  8 | #include <iostream> // print
  9 | 
 10 | template<class T> class FwdListIter;
 11 | 
 12 | template<class T>
 13 | class List
 14 | {
 15 |     struct Item
 16 |     {
 17 |         Item(T v, std::shared_ptr<const Item> tail)
 18 |         : _val(v), _next(std::move(tail))
 19 |         {}
 20 |         // singleton
 21 |         explicit Item(T v) : _val(v) {}
 22 |         T _val;
 23 |         std::shared_ptr<const Item> _next;
 24 |     };
 25 |     friend Item;
 26 |     explicit List(std::shared_ptr<const Item> items)
 27 |         : _head(std::move(items)) {}
 28 | public:
 29 |     // Empty list
 30 |     List() {}
 31 |     // Cons
 32 |     List(T v, List const & tail)
 33 |         : _head(std::make_shared<Item>(v, tail._head)) {}
 34 |     // Singleton
 35 |     explicit List(T v) : _head(std::make_shared<Item>(v)) {}
 36 |     // From initializer list
 37 |     List(std::initializer_list<T> init)
 38 |     {
 39 |         for (auto it = std::rbegin(init); it != std::rend(init); ++it)
 40 |         {
 41 |             _head = std::make_shared<Item>(*it, _head);
 42 |         }
 43 |     }
 44 | 
 45 |     bool isEmpty() const { return !_head; }
 46 |     T front() const
 47 |     {
 48 |         assert(!isEmpty());
 49 |         return _head->_val;
 50 |     }
 51 |     List popped_front() const
 52 |     {
 53 |         assert(!isEmpty());
 54 |         return List(_head->_next);
 55 |     }
 56 |     // Additional utilities
 57 |     List pushed_front(T v) const
 58 |     {
 59 |         return List(v, *this);
 60 |     }
 61 |     List take(int n)
 62 |     {
 63 |         if (n <= 0 || isEmpty()) return List();
 64 |         return popped_front().take(n - 1).pushed_front(front());
 65 |     }
 66 | private:
 67 |     std::shared_ptr<const Item> _head;
 68 | };
 69 | 
 70 | template<class T, class F>
 71 | auto fmap(F f, List<T> lst) -> List<decltype(f(lst.front()))>
 72 | {
 73 |     using U = decltype(f(lst.front()));
 74 |     static_assert(std::is_convertible<F, std::function<U(T)>>::value,
 75 |         "fmap requires a function type U(T)");
 76 |     List<U> result;
 77 |     forEach(lst, [&](T x) {
 78 |         result = result.pushed_front(f(x));
 79 |     });
 80 |     return result;
 81 | }
 82 | 
 83 | template<class T>
 84 | List<T> concat(List<T> const & a, List<T> const & b)
 85 | {
 86 |     if (a.isEmpty())
 87 |         return b;
 88 |     return List<T>(a.front(), concat(a.popped_front(), b));
 89 | }
 90 | 
 91 | template<class T>
 92 | List<T> concatAll(List<List<T>> const & xss)
 93 | {
 94 |     List<T> result;
 95 |     forEach(xss, [&](List<T> const & xs){
 96 |         forEach(xs, [&](T const & e) {
 97 |             result = result.pushed_front(e);
 98 |         });
 99 |     });
100 |     return result;
101 | }
102 | 
103 | // consumes the list when called: 
104 | // forEach(std::move(lst), f);
105 | 
106 | template<class T, class F>
107 | void forEach(List<T> lst, F f)
108 | {
109 |     static_assert(std::is_convertible<F, std::function<void(T)>>::value,
110 |         "forEach requires a function type void(T)");
111 |     while (!lst.isEmpty()) {
112 |         f(lst.front());
113 |         lst = lst.popped_front();
114 |     }
115 | }
116 | 
117 | template<class T>
118 | std::ostream& operator<<(std::ostream& os, List<T> const & lst)
119 | {
120 |     os << "[";
121 |     forEach(lst, [&os](T v) {
122 |         os << v << " ";
123 |     });
124 |     os << "]";
125 |     return os;
126 | }
127 | 
128 | #endif
129 | 


--------------------------------------------------------------------------------
/Advanced/RBMap.h:
--------------------------------------------------------------------------------
  1 | #include <cassert>
  2 | #include <memory>
  3 | 
  4 | enum Color { R, B };
  5 | 
  6 | // 1. No red node has a red child.
  7 | // 2. Every path from rootKey to empty node contains the same
  8 | // number of black nodes.
  9 | 
 10 | template<class K, class V>
 11 | class RBMap
 12 | {
 13 |     struct Node
 14 |     {
 15 |         Node(Color c,
 16 |         std::shared_ptr<const Node> const & lft,
 17 |         K key, V val,
 18 |         std::shared_ptr<const Node> const & rgt)
 19 |         : _c(c), _lft(lft), _key(key), _val(val), _rgt(rgt)
 20 |         {}
 21 |         Color _c;
 22 |         std::shared_ptr<const Node> _lft;
 23 |         K _key;
 24 |         V _val;
 25 |         std::shared_ptr<const Node> _rgt;
 26 |     };
 27 |     explicit RBMap(std::shared_ptr<const Node> const & node) : _root(node) {}
 28 |     Color rootColor() const
 29 |     {
 30 |         assert(!isEmpty());
 31 |         return _root->_c;
 32 |     }
 33 | public:
 34 |     RBMap() {}
 35 |     RBMap(Color c, RBMap const & lft, K key, V val, RBMap const & rgt)
 36 |         : _root(std::make_shared<const Node>(c, lft._root, key, val, rgt._root))
 37 |     {
 38 |         assert(lft.isEmpty() || lft.rootKey() < key);
 39 |         assert(rgt.isEmpty() || key < rgt.rootKey());
 40 |     }
 41 |     bool isEmpty() const { return !_root; }
 42 |     K rootKey() const
 43 |     {
 44 |         assert(!isEmpty());
 45 |         return _root->_key;
 46 |     }
 47 |     V rootValue() const
 48 |     {
 49 |         assert(!isEmpty());
 50 |         return _root->_val;
 51 |     }
 52 |     RBMap left() const
 53 |     {
 54 |         assert(!isEmpty());
 55 |         return RBMap(_root->_lft);
 56 |     }
 57 |     RBMap right() const
 58 |     {
 59 |         assert(!isEmpty());
 60 |         return RBMap(_root->_rgt);
 61 |     }
 62 |     bool member(K x) const
 63 |     {
 64 |         if (isEmpty())
 65 |             return false;
 66 |         K y = rootKey();
 67 |         if (x < y)
 68 |             return left().member(x);
 69 |         else if (y < x)
 70 |             return right().member(x);
 71 |         else
 72 |             return true;
 73 |     }
 74 |     V findWithDefault(V dflt, K key) const
 75 |     {
 76 |         if (isEmpty())
 77 |             return dflt;
 78 |         K y = rootKey();
 79 |         if (key < y)
 80 |             return left().findWithDefault(dflt, key);
 81 |         else if (y < key)
 82 |             return right().findWithDefault(dflt, key);
 83 |         else
 84 |             return rootValue();
 85 |     }
 86 |     RBMap inserted(K x, V v) const
 87 |     {
 88 |         RBMap t = ins(x, v);
 89 |         return RBMap(B, t.left(), t.rootKey(), t.rootValue(), t.right());
 90 |     }
 91 |     template<class F>
 92 |     RBMap insertedWith(K k, V v, F combine)
 93 |     {
 94 |         RBMap t = insWith(k, v, combine);
 95 |         return RBMap(B, t.left(), t.rootKey(), t.rootValue(), t.right());
 96 |     }
 97 |     // 1. No red node has a red child.
 98 |     void assert1() const
 99 |     {
100 |         if (!isEmpty())
101 |         {
102 |             auto lft = left();
103 |             auto rgt = right();
104 |             if (rootColor() == R)
105 |             {
106 |                 assert(lft.isEmpty() || lft.rootColor() == B);
107 |                 assert(rgt.isEmpty() || rgt.rootColor() == B);
108 |             }
109 |             lft.assert1();
110 |             rgt.assert1();
111 |         }
112 |     }
113 |     // 2. Every path from root to empty node contains the same
114 |     // number of black nodes.
115 |     int countB() const
116 |     {
117 |         if (isEmpty())
118 |             return 0;
119 |         int lft = left().countB();
120 |         int rgt = right().countB();
121 |         assert(lft == rgt);
122 |         return (rootColor() == B) ? 1 + lft : lft;
123 |     }
124 | private:
125 |     RBMap ins(K x, V v) const
126 |     {
127 |         assert1();
128 |         if (isEmpty())
129 |             return RBMap(R, RBMap(), x, v, RBMap());
130 |         K y = rootKey();
131 |         V yv = rootValue();
132 |         Color c = rootColor();
133 |         if (rootColor() == B)
134 |         {
135 |             if (x < y)
136 |                 return balance(left().ins(x, v), y, yv, right());
137 |             else if (y < x)
138 |                 return balance(left(), y, yv, right().ins(x, v));
139 |             else
140 |                 return *this; // no duplicates
141 |         }
142 |         else
143 |         {
144 |             if (x < y)
145 |                 return RBMap(c, left().ins(x, v), y, yv, right());
146 |             else if (y < x)
147 |                 return RBMap(c, left(), y, yv, right().ins(x, v));
148 |             else
149 |                 return *this; // no duplicates
150 |         }
151 |     }
152 |     template<class F>
153 |     RBMap insWith(K x, V v, F combine) const
154 |     {
155 |         assert1();
156 |         if (isEmpty())
157 |             return RBMap(R, RBMap(), x, v, RBMap());
158 |         K y = rootKey();
159 |         V yv = rootValue();
160 |         Color c = rootColor();
161 |         if (rootColor() == B)
162 |         {
163 |             if (x < y)
164 |                 return balance(left().insWith(x, v, combine), y, yv, right());
165 |             else if (y < x)
166 |                 return balance(left(), y, yv, right().insWith(x, v, combine));
167 |             else
168 |                 return RBMap(c, left(), y, combine(yv, v), right());
169 |         }
170 |         else
171 |         {
172 |             if (x < y)
173 |                 return RBMap(c, left().insWith(x, v, combine), y, yv, right());
174 |             else if (y < x)
175 |                 return RBMap(c, left(), y, yv, right().insWith(x, v, combine));
176 |             else
177 |                 return RBMap(c, left(), y, combine(yv, v), right());
178 |         }
179 |     }
180 |     // Called only when parent is black
181 |     static RBMap balance(RBMap const & lft, K x, V v, RBMap const & rgt)
182 |     {
183 |         if (lft.doubledLeft())
184 |             return RBMap(R
185 |             , lft.left().paint(B)
186 |             , lft.rootKey()
187 |             , lft.rootValue()
188 |             , RBMap(B, lft.right(), x, v, rgt));
189 |         else if (lft.doubledRight())
190 |             return RBMap(R
191 |             , RBMap(B, lft.left(), lft.rootKey(), lft.rootValue(), lft.right().left())
192 |             , lft.right().rootKey()
193 |             , lft.right().rootValue()
194 |             , RBMap(B, lft.right().right(), x, v, rgt));
195 |         else if (rgt.doubledLeft())
196 |             return RBMap(R
197 |             , RBMap(B, lft, x, v, rgt.left().left())
198 |             , rgt.left().rootKey()
199 |             , rgt.left().rootValue()
200 |             , RBMap(B, rgt.left().right(), rgt.rootKey(), rgt.rootValue(), rgt.right()));
201 |         else if (rgt.doubledRight())
202 |             return RBMap(R
203 |             , RBMap(B, lft, x, v, rgt.left())
204 |             , rgt.rootKey()
205 |             , rgt.rootValue()
206 |             , rgt.right().paint(B));
207 |         else
208 |             return RBMap(B, lft, x, v, rgt);
209 |     }
210 |     bool doubledLeft() const
211 |     {
212 |         return !isEmpty()
213 |             && rootColor() == R
214 |             && !left().isEmpty()
215 |             && left().rootColor() == R;
216 |     }
217 |     bool doubledRight() const
218 |     {
219 |         return !isEmpty()
220 |             && rootColor() == R
221 |             && !right().isEmpty()
222 |             && right().rootColor() == R;
223 |     }
224 |     RBMap paint(Color c) const
225 |     {
226 |         assert(!isEmpty());
227 |         return RBMap(c, left(), rootKey(), rootValue(), right());
228 |     }
229 | private:
230 |     std::shared_ptr<const Node> _root;
231 | };
232 | 
233 | template<class K, class V, class F>
234 | void forEach(RBMap<K, V> const & t, F f) {
235 |     if (!t.isEmpty()) {
236 |         forEach(t.left(), f);
237 |         f(t.rootKey(), t.rootValue());
238 |         forEach(t.right(), f);
239 |     }
240 | }
241 | 
242 | template<class K, class V, class I>
243 | RBMap<K, V> fromListOfPairs(I beg, I end)
244 | {
245 |     RBMap<K, V> map;
246 |     for (auto it = beg; it != end; ++it)
247 |         map = map.inserted(it->first, it->second);
248 |     return map;
249 | }
250 | 
251 | template<class K, class V>
252 | void print(RBMap<K, V> const & map)
253 | {
254 |     forEach(map, [](K k, V v) {
255 |         std::cout << k << "-> " << v << std::endl;
256 |     });
257 |     std::cout << std::endl;
258 | }
259 | 
260 | template<class K, class V>
261 | std::ostream& operator<<(std::ostream& os, RBMap<K, V> const & map)
262 | {
263 |     forEach(map, [&os](K k, V v) {
264 |         os << k << "-> " << v << std::endl;
265 |     });
266 |     os << std::endl;
267 |     return os;
268 | }
269 | 
270 | 


--------------------------------------------------------------------------------
/Advanced/StateList.h:
--------------------------------------------------------------------------------
  1 | #include "List.h"
  2 | #include <functional>
  3 | #include <tuple>
  4 | 
  5 | using namespace std;
  6 | 
  7 | using State = List<int>;
  8 | 
  9 | // newtype StateList s a = StateList (s -> [(a, s)])
 10 | template<class A>
 11 | using PairList = List<pair<A, State>>;
 12 | 
 13 | template<class A>
 14 | using StateList = function<PairList<A>(State)>;
 15 | 
 16 | // runStateList :: StateList s a -> s -> [(a, s)]
 17 | // runStateList(StateList g) s = g s
 18 | 
 19 | template<class A>
 20 | PairList<A> runStateList(StateList<A> st, State s)
 21 | {
 22 |     return st(s);
 23 | }
 24 | 
 25 | // evalStateList::StateList s a->s ->[a]
 26 | // evalStateList(StateList g) s = fmap fst(g s)
 27 | template<class A>
 28 | List<A> evalStateList(StateList<A> st, State s)
 29 | {
 30 |     return fmap([](pair<A, State> const & p)->A {
 31 |         return p.first;
 32 |     }, st(s));
 33 | }
 34 | 
 35 | // return x = StateList(\s ->[(x, s)])
 36 | template<class A>
 37 | StateList<A> mreturn(A a)
 38 | {
 39 |     return [a](State s) { return PairList<A>(make_pair(a, s)); };
 40 | }
 41 | 
 42 | // (StateList g) >>= k = StateList(\s->concat $ fmap(\(a, s') -> runStateList (k a) s') (g s))
 43 | 
 44 | // k is a function<StateList<S, B>(A)>
 45 | // mbind returns StateList<S, B> 
 46 | 
 47 | template<class A, class F>
 48 | auto mbind(StateList<A> g, F k) -> decltype(k(g(State()).front().first))
 49 | {
 50 |     return [g, k](State s) {
 51 |         PairList<A> plst = g(s);
 52 |         //List<PairList<B>> 
 53 |         auto lst2 = fmap([k](pair<A, State> const & p) {
 54 |             A a = p.first;
 55 |             State s1 = p.second;
 56 |             auto ka = k(a);
 57 |             auto result = runStateList(ka, s1);
 58 |             return result;
 59 |         }, plst);
 60 |         return concatAll(lst2);
 61 |     };
 62 | }
 63 | 
 64 | // A version of mbind with a continuation that ignores its argument
 65 | template<class A, class F>
 66 | auto mthen(StateList<A> g, F k) -> decltype(k())
 67 | {
 68 |     return [g, k](State s) {
 69 |         PairList<A> plst = g(s);
 70 |         auto lst2 = fmap([k](pair<A, State> const & p) {
 71 |             State s1 = p.second;
 72 |             auto ka = k();
 73 |             auto result = runStateList(ka, s1);
 74 |             return result;
 75 |         }, plst);
 76 |         return concatAll(lst2);
 77 |     };
 78 | }
 79 | 
 80 | // mzero = StateList(\s ->[])
 81 | template<class A>
 82 | StateList<A> mzero()
 83 | {
 84 |     return[](State s) {
 85 |         return PairList<A>();
 86 |     };
 87 | }
 88 | 
 89 | StateList<void*> guard(bool b)
 90 | {
 91 |     if (b) {
 92 |         return [](State s) {
 93 |             return List<pair<void*, State>>(make_pair(nullptr, s));
 94 |         };
 95 |     }
 96 |     else
 97 |         return mzero<void*>();
 98 | }
 99 | 
100 | template<class S, class A>
101 | std::ostream& operator<<(std::ostream& os, pair<A, S> const & p)
102 | {
103 |     os << "(";
104 |     os << p.first << ", " << p.second;
105 |     os << ")";
106 |     return os;
107 | }
108 | 
109 | template<class A, class B, class C>
110 | std::ostream& operator<<(std::ostream& os, tuple<A, B, C> const & t)
111 | {
112 |     os << "(";
113 |     os << get<0>(t) << ", " << get<1>(t) << ", " << get<2>(t);
114 |     os << ")";
115 |     return os;
116 | }
117 | 


--------------------------------------------------------------------------------
/Calc/Calc.cpp:
--------------------------------------------------------------------------------
  1 | #include <cassert>
  2 | #include <tuple>
  3 | #include "List.h"
  4 | using namespace std;
  5 | 
  6 | enum ItemType { Plus, Minus, Num };
  7 | 
  8 | struct Item
  9 | {
 10 |     ItemType _type;
 11 |     int _num;
 12 |     Item(int i) : _type(Num), _num(i) {}
 13 |     Item(ItemType t) : _type(t), _num(-1) {}
 14 | };
 15 | 
 16 | std::ostream& operator<<(std::ostream& os, Item const & it)
 17 | {
 18 |     switch (it._type)
 19 |     {
 20 |     case Plus: os << "+"; break;
 21 |     case Minus: os << "-"; break;
 22 |     case Num: os << it._num; break;
 23 |     }
 24 |     return os;
 25 | }
 26 | 
 27 | using State = List<Item>;
 28 | 
 29 | // To retrieve A from Plan<A> pl
 30 | // decltype(pl(State()).first)
 31 | template<class A>
 32 | using Plan = function<pair<A, State>(State)>;
 33 | 
 34 | template<class A>
 35 | pair<A, State> runPlan(Plan<A> pl, State s)
 36 | {
 37 |     return pl(s);
 38 | }
 39 | 
 40 | template<class A>
 41 | A evalPlan(Plan<A> pl, State s)
 42 | {
 43 |     return runPlan(pl, s).first;
 44 | }
 45 | 
 46 | template<class A>
 47 | Plan<A> mreturn(A a)
 48 | {
 49 |     return [a](State s) { return make_pair(a, s); };
 50 | }
 51 | 
 52 | template<class A, class F>
 53 | auto mbind(Plan<A> pl, F k) -> decltype(k(pl(State()).first))
 54 | {
 55 |     using B = decltype(k(pl(State()).first)(State()).first);
 56 |     static_assert(std::is_convertible<
 57 |         F, std::function<Plan<B>(A) >> ::value,
 58 |         "mbind requires a function type Plan<B>(A)");
 59 | 
 60 |     return [pl, k](State s) {
 61 |         pair<A, State> ps = runPlan(pl, s);
 62 |         Plan<B> plB = k(ps.first);
 63 |         return runPlan(plB, ps.second);
 64 |     };
 65 | }
 66 | 
 67 | // A version of mbind with a continuation that ignores its argument
 68 | template<class A, class F>
 69 | auto mthen(Plan<A> pl, F k) -> decltype(k())
 70 | {
 71 |     using B = decltype(k()(State()).first);
 72 |     static_assert(std::is_convertible<
 73 |         F, std::function<Plan<B>() >> ::value,
 74 |         "mthen requires a function type Plan<B>()");
 75 | 
 76 |     return [pl, k](State s) {
 77 |         pair<A, State> ps = pl(s);
 78 |         // ignore ps.first
 79 |         Plan<B> plB = k();
 80 |         return runPlan(plB, ps.second);
 81 |     };
 82 | }
 83 | 
 84 | Plan<State> getState()
 85 | {
 86 |     return [](State s) { return make_pair(s, s); };
 87 | }
 88 | 
 89 | Plan<void*> putState(State newState)
 90 | {
 91 |     return [newState](State s) { return make_pair(nullptr, newState); };
 92 | }
 93 | 
 94 | Plan<Item> pop()
 95 | {
 96 |     return mbind(getState(), [](State s) {
 97 |         Item it = s.front();
 98 |         return mthen(putState(s.popped_front()), [=]() {
 99 |             return mreturn(it);
100 |         });
101 |     });
102 | }
103 | 
104 | Plan<int> calc();
105 | 
106 | Plan<int> add()
107 | {
108 |     return mbind(calc(), [](int n) {
109 |         return mbind(calc(), [=](int m) {
110 |             return mreturn(n + m);
111 |         });
112 |     });
113 | }
114 | 
115 | Plan<int> subtract()
116 | {
117 |     return mbind(calc(), [](int n) {
118 |         return mbind(calc(), [=](int m) {
119 |             return mreturn(n - m);
120 |         });
121 |     });
122 | }
123 | 
124 | Plan<int> calc()
125 | {
126 |     return mbind(pop(), [](Item it) {
127 |         switch (it._type)
128 |         {
129 |         case Plus:  return add();
130 |         case Minus: return subtract();
131 |         case Num:   return mreturn(it._num);
132 |         };
133 |     });
134 | }
135 | 
136 | template<class S, class A>
137 | std::ostream& operator<<(std::ostream& os, pair<A, S> const & p)
138 | {
139 |     os << "(";
140 |     os << p.first << ", " << p.second;
141 |     os << ")";
142 |     return os;
143 | }
144 | 
145 | void test()
146 | {
147 |     List<Item> stack{ Item(Plus), Item(Minus), Item(4), Item(8), Item(3) };
148 |     cout << evalPlan(calc(), stack) << endl;
149 | }
150 | 
151 | int main()
152 | {
153 |     test();
154 |     return 0;
155 | }
156 | 


--------------------------------------------------------------------------------
/Calc/List.h:
--------------------------------------------------------------------------------
  1 | #if ! defined(LIST_H)
  2 | #define LIST_H
  3 | 
  4 | #include <cassert>
  5 | #include <memory>
  6 | #include <functional>
  7 | #include <initializer_list>
  8 | #include <iostream> // print
  9 | 
 10 | template<class T> class FwdListIter;
 11 | 
 12 | template<class T>
 13 | class List
 14 | {
 15 |     struct Item
 16 |     {
 17 |         Item(T v, std::shared_ptr<const Item> tail)
 18 |         : _val(v), _next(std::move(tail))
 19 |         {}
 20 |         // singleton
 21 |         explicit Item(T v) : _val(v) {}
 22 |         T _val;
 23 |         std::shared_ptr<const Item> _next;
 24 |     };
 25 |     friend Item;
 26 |     explicit List(std::shared_ptr<const Item> items)
 27 |         : _head(std::move(items)) {}
 28 | public:
 29 |     // Empty list
 30 |     List() {}
 31 |     // Cons
 32 |     List(T v, List const & tail)
 33 |         : _head(std::make_shared<Item>(v, tail._head)) {}
 34 |     // Singleton
 35 |     explicit List(T v) : _head(std::make_shared<Item>(v)) {}
 36 |     // From initializer list
 37 |     List(std::initializer_list<T> init)
 38 |     {
 39 |         for (auto it = std::rbegin(init); it != std::rend(init); ++it)
 40 |         {
 41 |             _head = std::make_shared<Item>(*it, _head);
 42 |         }
 43 |     }
 44 | 
 45 |     bool isEmpty() const { return !_head; }
 46 |     T front() const
 47 |     {
 48 |         assert(!isEmpty());
 49 |         return _head->_val;
 50 |     }
 51 |     List popped_front() const
 52 |     {
 53 |         assert(!isEmpty());
 54 |         return List(_head->_next);
 55 |     }
 56 |     // Additional utilities
 57 |     List pushed_front(T v) const
 58 |     {
 59 |         return List(v, *this);
 60 |     }
 61 |     List take(int n)
 62 |     {
 63 |         if (n <= 0 || isEmpty()) return List();
 64 |         return popped_front().take(n - 1).pushed_front(front());
 65 |     }
 66 | private:
 67 |     std::shared_ptr<const Item> _head;
 68 | };
 69 | 
 70 | template<class T, class F>
 71 | auto fmap(F f, List<T> lst) -> List<decltype(f(lst.front()))>
 72 | {
 73 |     using U = decltype(f(lst.front()));
 74 |     static_assert(std::is_convertible<F, std::function<U(T)>>::value,
 75 |         "fmap requires a function type U(T)");
 76 |     List<U> result;
 77 |     forEach(lst, [&](T x) {
 78 |         result = result.pushed_front(f(x));
 79 |     });
 80 |     return result;
 81 | }
 82 | 
 83 | template<class T>
 84 | List<T> concat(List<T> const & a, List<T> const & b)
 85 | {
 86 |     if (a.isEmpty())
 87 |         return b;
 88 |     return List<T>(a.front(), concat(a.popped_front(), b));
 89 | }
 90 | 
 91 | template<class T>
 92 | List<T> concatAll(List<List<T>> const & xss)
 93 | {
 94 |     List<T> result;
 95 |     forEach(xss, [&](List<T> const & xs){
 96 |         forEach(xs, [&](T const & e) {
 97 |             result = result.pushed_front(e);
 98 |         });
 99 |     });
100 |     return result;
101 | }
102 | 
103 | // consumes the list when called: 
104 | // forEach(std::move(lst), f);
105 | 
106 | template<class T, class F>
107 | void forEach(List<T> lst, F f)
108 | {
109 |     static_assert(std::is_convertible<F, std::function<void(T)>>::value,
110 |         "forEach requires a function type void(T)");
111 |     while (!lst.isEmpty()) {
112 |         f(lst.front());
113 |         lst = lst.popped_front();
114 |     }
115 | }
116 | 
117 | template<class T>
118 | std::ostream& operator<<(std::ostream& os, List<T> const & lst)
119 | {
120 |     os << "[";
121 |     forEach(lst, [&os](T v) {
122 |         os << v << " ";
123 |     });
124 |     os << "]";
125 |     return os;
126 | }
127 | 
128 | #endif
129 | 


--------------------------------------------------------------------------------
/Full/List.h:
--------------------------------------------------------------------------------
  1 | #if ! defined(LIST_H)
  2 | #define LIST_H
  3 | 
  4 | #include <cassert>
  5 | #include <memory>
  6 | #include <functional>
  7 | #include <initializer_list>
  8 | #include <iostream> // print
  9 | 
 10 | template<class T> class FwdListIter;
 11 | 
 12 | template<class T>
 13 | class List
 14 | {
 15 |     struct Item
 16 |     {
 17 |         Item(T v, std::shared_ptr<const Item> tail)
 18 |         : _val(v), _next(std::move(tail))
 19 |         {}
 20 |         // singleton
 21 |         explicit Item(T v) : _val(v) {}
 22 |         T _val;
 23 |         std::shared_ptr<const Item> _next;
 24 |     };
 25 |     friend Item;
 26 |     explicit List(std::shared_ptr<const Item> items)
 27 |         : _head(std::move(items)) {}
 28 | public:
 29 |     // Empty list
 30 |     List() {}
 31 |     // Cons
 32 |     List(T v, List const & tail)
 33 |         : _head(std::make_shared<Item>(v, tail._head)) {}
 34 |     // Singleton
 35 |     explicit List(T v) : _head(std::make_shared<Item>(v)) {}
 36 |     // From initializer list
 37 |     List(std::initializer_list<T> init)
 38 |     {
 39 |         for (auto it = std::rbegin(init); it != std::rend(init); ++it)
 40 |         {
 41 |             _head = std::make_shared<Item>(*it, _head);
 42 |         }
 43 |     }
 44 | 
 45 |     bool isEmpty() const { return !_head; }
 46 |     T front() const
 47 |     {
 48 |         assert(!isEmpty());
 49 |         return _head->_val;
 50 |     }
 51 |     List popped_front() const
 52 |     {
 53 |         assert(!isEmpty());
 54 |         return List(_head->_next);
 55 |     }
 56 |     // Additional utilities
 57 |     List pushed_front(T v) const
 58 |     {
 59 |         return List(v, *this);
 60 |     }
 61 |     List take(int n)
 62 |     {
 63 |         if (n <= 0 || isEmpty()) return List();
 64 |         return popped_front().take(n - 1).pushed_front(front());
 65 |     }
 66 | private:
 67 |     std::shared_ptr<const Item> _head;
 68 | };
 69 | 
 70 | template<class T, class F>
 71 | auto fmap(F f, List<T> lst) -> List<decltype(f(lst.front()))>
 72 | {
 73 |     using U = decltype(f(lst.front()));
 74 |     static_assert(std::is_convertible<F, std::function<U(T)>>::value,
 75 |         "fmap requires a function type U(T)");
 76 |     List<U> result;
 77 |     forEach(lst, [&](T x) {
 78 |         result = result.pushed_front(f(x));
 79 |     });
 80 |     return result;
 81 | }
 82 | 
 83 | template<class T>
 84 | List<T> concat(List<T> const & a, List<T> const & b)
 85 | {
 86 |     if (a.isEmpty())
 87 |         return b;
 88 |     return List<T>(a.front(), concat(a.popped_front(), b));
 89 | }
 90 | 
 91 | template<class T>
 92 | List<T> concatAll(List<List<T>> const & xss)
 93 | {
 94 |     List<T> result;
 95 |     forEach(xss, [&](List<T> const & xs){
 96 |         forEach(xs, [&](T const & e) {
 97 |             result = result.pushed_front(e);
 98 |         });
 99 |     });
100 |     return result;
101 | }
102 | 
103 | // List monad
104 | 
105 | template<class A, class F>
106 | auto for_each(List<A> lst, F k) -> decltype(k(lst.front()))
107 | {
108 |     using B = decltype(k(lst.front()).front());
109 |     static_assert(std::is_convertible<
110 |         F, std::function<List<B>(A) >> ::value,
111 |         "for_each requires a function type List<B>(A)");
112 | 
113 |     List<List<B>> lstLst = fmap(k, lst);
114 |     return concatAll(lstLst);
115 | }
116 | 
117 | template<class A>
118 | List<A> yield(A a)
119 | {
120 |     return List<A>(a);
121 | }
122 | 
123 | // consumes the list when called: 
124 | // forEach(std::move(lst), f);
125 | 
126 | template<class T, class F>
127 | void forEach(List<T> lst, F f)
128 | {
129 |     static_assert(std::is_convertible<F, std::function<void(T)>>::value,
130 |         "forEach requires a function type void(T)");
131 |     while (!lst.isEmpty()) {
132 |         f(lst.front());
133 |         lst = lst.popped_front();
134 |     }
135 | }
136 | 
137 | template<class T>
138 | std::ostream& operator<<(std::ostream& os, List<T> const & lst)
139 | {
140 |     os << "[";
141 |     forEach(lst, [&os](T v) {
142 |         os << v << " ";
143 |     });
144 |     os << "]";
145 |     return os;
146 | }
147 | 
148 | #endif
149 | 


--------------------------------------------------------------------------------
/Full/MoreMoney.cpp:
--------------------------------------------------------------------------------
 1 | #include "StateList.h"
 2 | #include <vector>
 3 | #include <string>
 4 | using namespace std;
 5 | 
 6 | template<class A>
 7 | PairList<List<A>, A> select(List<A> lst)
 8 | {
 9 |     if (lst.isEmpty())
10 |         return PairList<List<A>, A>();
11 | 
12 |     A       x  = lst.front();
13 |     List<A> xs = lst.popped_front();
14 | 
15 |     auto result = List<pair<A, List<A>>>();
16 |     forEach(select(xs), [x, &result](pair<A, List<A>> const & p)
17 |     {
18 |         A       y = p.first;
19 |         List<A> ys = p.second;
20 |         auto y_xys = make_pair(y, ys.pushed_front(x));
21 |         result = result.pushed_front(y_xys);
22 |     });
23 | 
24 |     return result.pushed_front(make_pair(x, xs));
25 | }
26 | 
27 | int asNumber(vector<int> const & v)
28 | {
29 |     int acc = 0;
30 |     for (auto i : v)
31 |     {
32 |         acc = 10 * acc + i;
33 |     }
34 |     return acc;
35 | }
36 | 
37 | StateList<List<int>, tuple<int, int, int>> solve()
38 | {
39 |     StateList<List<int>, int> sel = &select<int>;
40 | 
41 |     return mbind(sel, [=](int s) {
42 |     return mbind(sel, [=](int e) {
43 |     return mbind(sel, [=](int n) {
44 |     return mbind(sel, [=](int d) {
45 |     return mbind(sel, [=](int m) {
46 |     return mbind(sel, [=](int o) {
47 |     return mbind(sel, [=](int r) {
48 |     return mbind(sel, [=](int y) {
49 |     return mthen(guard<List<int>>(s != 0 && m != 0), [=]() {
50 |         int send  = asNumber(vector<int>{s, e, n, d});
51 |         int more  = asNumber(vector<int>{m, o, r, e});
52 |         int money = asNumber(vector<int>{m, o, n, e, y});
53 |         return mthen(guard<List<int>>(send + more == money), [=]() {
54 |             return mreturn<List<int>>(make_tuple(send, more, money));
55 |         });
56 |     }); }); }); }); }); }); }); }); });
57 | }
58 | 
59 | void testMonad()
60 | {
61 |     List<int>    lst1{ 1, 2, 3,};
62 |     List<string> lst2{ "one", "two", "three" };
63 | 
64 |     List<pair<int, string>> pairs =
65 |     for_each(lst1, [=](int i) { return
66 |     for_each(lst2, [=](string s) { return
67 |             yield(make_pair(i, s));
68 |     }); });
69 |     cout << pairs << endl;
70 | }
71 | 
72 | int main()
73 | {
74 |     testMonad();
75 |     List<int> lst{ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 };
76 |     cout << evalStateList(solve(), lst);
77 |     return 0;
78 | }


--------------------------------------------------------------------------------
/Full/StateList.h:
--------------------------------------------------------------------------------
  1 | #include "List.h"
  2 | #include <functional>
  3 | #include <tuple>
  4 | 
  5 | using namespace std;
  6 | 
  7 | // newtype StateList s a = StateList (s -> [(a, s)])
  8 | template<class State, class A>
  9 | using PairList = List<pair<A, State>>;
 10 | 
 11 | template<class State, class A>
 12 | using StateList = function<PairList<State, A>(State)>;
 13 | 
 14 | // runStateList :: StateList s a -> s -> [(a, s)]
 15 | // runStateList(StateList g) s = g s
 16 | 
 17 | template<class State, class A>
 18 | PairList<State, A> runStateList(StateList<State, A> st, State s)
 19 | {
 20 |     return st(s);
 21 | }
 22 | 
 23 | // evalStateList::StateList s a->s ->[a]
 24 | // evalStateList(StateList g) s = fmap fst(g s)
 25 | template<class State, class A>
 26 | List<A> evalStateList(StateList<State, A> st, State s)
 27 | {
 28 |     return fmap([](pair<A, State> const & p)->A {
 29 |         return p.first;
 30 |     }, st(s));
 31 | }
 32 | 
 33 | // return x = StateList(\s ->[(x, s)])
 34 | template<class State, class A>
 35 | StateList<State, A> mreturn(A a)
 36 | {
 37 |     return [a](State s) { return PairList<State, A>(make_pair(a, s)); };
 38 | }
 39 | 
 40 | // (StateList g) >>= k = StateList(\s->concat $ fmap(\(a, s') -> runStateList (k a) s') (g s))
 41 | 
 42 | // k is a function<StateList<S, B>(A)>
 43 | // mbind returns StateList<S, B> 
 44 | 
 45 | template<class State, class A, class F>
 46 | auto mbind(StateList<State, A> g, F k) -> decltype(k(g(State()).front().first))
 47 | {
 48 |     return [g, k](State s) {
 49 |         PairList<State, A> plst = g(s);
 50 |         //List<PairList<B>> 
 51 |         auto lst2 = fmap([k](pair<A, State> const & p) {
 52 |             A a = p.first;
 53 |             State s1 = p.second;
 54 |             auto ka = k(a);
 55 |             auto result = runStateList(ka, s1);
 56 |             return result;
 57 |         }, plst);
 58 |         return concatAll(lst2);
 59 |     };
 60 | }
 61 | 
 62 | // A version of mbind with a continuation that ignores its argument
 63 | template<class State, class A, class F>
 64 | auto mthen(StateList<State, A> g, F k) -> decltype(k())
 65 | {
 66 |     return [g, k](State s) {
 67 |         PairList<State, A> plst = g(s);
 68 |         auto lst2 = fmap([k](pair<A, State> const & p) {
 69 |             State s1 = p.second;
 70 |             auto ka = k();
 71 |             auto result = runStateList(ka, s1);
 72 |             return result;
 73 |         }, plst);
 74 |         return concatAll(lst2);
 75 |     };
 76 | }
 77 | 
 78 | // mzero = StateList(\s ->[])
 79 | template<class State, class A>
 80 | StateList<State, A> mzero()
 81 | {
 82 |     return[](State s) {
 83 |         return PairList<State, A>();
 84 |     };
 85 | }
 86 | 
 87 | template<class State>
 88 | StateList<State, void*> guard(bool b)
 89 | {
 90 |     if (b) {
 91 |         return [](State s) {
 92 |             return List<pair<void*, State>>(make_pair(nullptr, s));
 93 |         };
 94 |     }
 95 |     else
 96 |         return mzero<State, void*>();
 97 | }
 98 | 
 99 | template<class S, class A>
100 | std::ostream& operator<<(std::ostream& os, pair<A, S> const & p)
101 | {
102 |     os << "(";
103 |     os << p.first << ", " << p.second;
104 |     os << ")";
105 |     return os;
106 | }
107 | 
108 | template<class A, class B, class C>
109 | std::ostream& operator<<(std::ostream& os, tuple<A, B, C> const & t)
110 | {
111 |     os << "(";
112 |     os << get<0>(t) << ", " << get<1>(t) << ", " << get<2>(t);
113 |     os << ")";
114 |     return os;
115 | }
116 | 
117 | 


--------------------------------------------------------------------------------
/Haskell/Advanced.hs:
--------------------------------------------------------------------------------
 1 | module Advanced where
 2 | 
 3 | import Control.Monad
 4 | import Control.Applicative
 5 | import Control.Arrow (first)
 6 | import Data.Maybe (fromJust)
 7 | import Data.List (nub)
 8 | import qualified Data.Map.Strict as M
 9 | 
10 | newtype StateL s a = StateL (s -> [(a, s)])
11 | 
12 | runStateL :: StateL s a -> s -> [(a, s)]
13 | runStateL (StateL g) = g
14 | 
15 | evalStateL :: StateL s a -> s -> [a]
16 | evalStateL (StateL g) s = fmap fst (g s)
17 | 
18 | instance Functor (StateL s) where
19 |     fmap f (StateL g) = StateL $ fmap (first f) . g
20 | 
21 | instance Applicative (StateL s) where
22 |     pure x = StateL $ \s -> [(x, s)]
23 |     fs <*> xs = StateL $ \s -> [(f a, s'') | (f, s' ) <- runStateL fs s
24 |                                            , (a, s'') <- runStateL xs s]
25 | 
26 | instance Alternative (StateL s) where
27 |     empty = StateL $ const []
28 |     as <|> bs = StateL $ \s -> runStateL as s ++ runStateL bs s
29 | 
30 | instance Monad (StateL s) where
31 |     return = pure
32 |     --(StateL g) >>= k = StateL $ concat . fmap (\(a, s) -> runStateL (k a) s) . g
33 |     (StateL g) >>= k = StateL $ \s -> [(b, s'') | (a, s' ) <- g s
34 |                                                 , (b, s'') <- runStateL (k a) s']
35 | 
36 | instance MonadPlus (StateL s) where
37 |     mzero = empty
38 |     mplus = (<|>)
39 | 
40 | select ::[a] ->[(a, [a])]
41 | select [] = []
42 | select(x:xs) = (x, xs) : [(y, x:ys) | (y, ys) <-select xs]
43 | 
44 | --     S E N D
45 | -- +   M O R E
46 | -- -----------
47 | --   M O N E Y
48 | 
49 | solve :: StateL [Int] (Int, Int, Int)
50 | solve = StateL select >>= go (nub "sendmoremoney") M.empty
51 |   where
52 |     go [c] subst i = prune (M.insert c i subst)
53 |     go (c:cs) subst i = StateL select >>= go cs (M.insert c i subst)
54 |     prune subst = do
55 |         guard (get 's' /= 0 && get 'm' /= 0)
56 |         let send  = toNumber "send"
57 |             more  = toNumber "more"
58 |             money = toNumber "money"
59 |         guard $ send + more == money
60 |         return (send, more, money)
61 |       where
62 |         get c = fromJust (M.lookup c subst)
63 |         toNumber str = asNumber (map get str)
64 |         asNumber = foldl (\t o -> t*10 + o) 0
65 | 
66 | main = print $ evalStateL solve [0..9]
67 | 


--------------------------------------------------------------------------------
/Haskell/Calc.hs:
--------------------------------------------------------------------------------
 1 | module Calc where
 2 | import Control.Monad.State
 3 | 
 4 | data Item = Plus | Minus | Number Int
 5 |     deriving (Show, Eq)
 6 | 
 7 | type Plan = State [Item]
 8 | 
 9 | pop :: Plan Item
10 | pop = do
11 |     s <- get
12 |     put (tail s)
13 |     return (head s)
14 | 
15 | plus :: Plan Int
16 | plus = do
17 |     n <- calc
18 |     m <- calc
19 |     return (n + m)
20 |     
21 | 
22 | minus :: Plan Int
23 | minus = do
24 |     n <- calc
25 |     m <- calc
26 |     return (n - m)
27 |     
28 | 
29 | calc :: Plan Int
30 | calc = do
31 |     it <- pop
32 |     case it of
33 |         Plus     -> plus
34 |         Minus    -> minus
35 |         Number n -> return n
36 |         
37 | main :: IO ()
38 | main = print $ runState calc [Plus, Minus, Number 2, Number 4, Number 1]
39 | 


--------------------------------------------------------------------------------
/Haskell/Main.hs:
--------------------------------------------------------------------------------
 1 | module Main where
 2 | 
 3 | import Control.Monad
 4 | 
 5 | newtype StateL s a = StateL (s -> [(a, s)])
 6 | 
 7 | runStateL :: StateL s a -> s -> [(a, s)]
 8 | runStateL (StateL g) s = g s
 9 | 
10 | evalStateL :: StateL s a -> s -> [a]
11 | evalStateL (StateL g) s = fmap fst (g s)
12 | 
13 | instance Functor (StateL s) where
14 |     fmap f (StateL g) = StateL (\s -> fmap (\(a, s')-> (f a, s')) (g s))
15 | 
16 | instance Monad (StateL s) where
17 |     return x = StateL (\s -> [(x, s)])
18 |     (StateL g) >>= k = StateL (\s -> concat $ fmap (\(a, s') -> runStateL (k a) s') (g s))
19 | 
20 | instance MonadPlus (StateL s) where
21 |     mzero = StateL (\s -> [])
22 |     mplus = undefined
23 | 
24 | select ::[a] ->[(a, [a])]
25 | select[] = []
26 | select(x:xs) = (x, xs) : [(y, x:ys) | (y, ys) <-select xs]
27 | 
28 | asNumber :: [Int] -> Int
29 | asNumber = foldl (\t o -> t*10 + o) 0
30 | 
31 | --     S E N D
32 | -- +   M O R E
33 | -- -----------
34 | --   M O N E Y
35 | 
36 | solve = do
37 |     s <- sel
38 |     e <- sel
39 |     n <- sel
40 |     d <- sel
41 |     m <- sel
42 |     o <- sel
43 |     r <- sel
44 |     y <- sel
45 |     guard (s /= 0 && m /= 0)
46 |     let send  = asNumber [s,e,n,d]
47 |         more  = asNumber [m,o,r,e]
48 |         money = asNumber [m,o,n,e,y]
49 |     guard (send + more == money)
50 |     return (send, more, money)
51 |   where sel = StateL select
52 | 
53 | main :: IO ()
54 | main = print $ evalStateL solve [0..9] 
55 | 
56 | test = StateL select >>= (\x -> StateL select >>= \y -> return (x, y))
57 | 
58 | 


--------------------------------------------------------------------------------
/Haskell/Solver.hs:
--------------------------------------------------------------------------------
 1 | module Solver where
 2 | 
 3 | import Control.Monad (guard, liftM, join)
 4 | import Control.Monad.Trans.State
 5 | import Control.Monad.Trans.Class
 6 | import qualified Data.Map.Strict as M
 7 | 
 8 | --     S E N D
 9 | -- +   M O R E
10 | -- -----------
11 | --   M O N E Y
12 | 
13 | -- PartialMap contains a list of digits,
14 | -- which don't have a mapping yet,
15 | -- and a map from Char to Int
16 | type PartialMap = ([Int], M.Map Char Int)
17 | type StateL = StateT PartialMap []
18 | 
19 | toNumber :: [Char] -> StateL Int
20 | toNumber str = do
21 |     digits <- mapM mapC str
22 |     return (asNumber digits)
23 | 
24 | asNumber :: [Int] -> Int
25 | asNumber = foldl (\t o -> t * 10 + o) 0
26 | 
27 | -- Look up the character in the map
28 | -- If not found, create all possible mappings for it using remaining digits
29 | -- Otherwise, return the digit mapped to it
30 | selC :: Char -> StateL Int
31 | selC c = do
32 |     (digits, subst) <- get
33 |     case M.lookup c subst of
34 |         Nothing -> do
35 |             i <- lift digits
36 |             put (filter (/= i) digits, M.insert c i subst)
37 |             return i
38 |         Just i  -> return i
39 | 
40 | -- Look up a character assuming it's already been mapped
41 | mapC :: Char -> StateL Int
42 | mapC c = do
43 |     (digits, subst) <- get
44 |     case M.lookup c subst of
45 |         Nothing -> error ("No mapping for " ++ [c])
46 |         Just i  -> return i
47 | 
48 | -- Find all substitutions for which addends add up to result
49 | -- No substitution may result in a number that starts with zero
50 | 
51 | solve :: [String] -> String -> StateL ([Int], Int)
52 | solve addends result =  go (map reverse addends) (reverse result) 0
53 |   where
54 |     -- Perform long addition, right to left (arguments are reversed)
55 |     -- For each character, look it up in the partial map
56 |     -- or generate all possible substitutions for it
57 |     go :: [String] -> String -> Int -> StateL ([Int], Int)
58 |     go [] result carry = finish result carry
59 |     go addends result carry = do
60 |         is <- mapM (selC . head) addends
61 |         r <- selC (head result)
62 |         let s = sum is + carry
63 |         guard (s `mod` 10 == r)
64 |         let tails = filter (not . null) $ map tail addends
65 |         go tails (tail result) (s `div` 10)
66 |     -- We have reached the left end of all addends
67 |     finish :: String -> Int -> StateL ([Int], Int)
68 |     finish [] carry = guard (carry == 0) >> prune
69 |     finish result carry = do
70 |         r <- selC (head result)
71 |         guard (r == carry && null (tail result))
72 |         prune
73 |     -- Make sure no number starts with zero
74 |     prune :: StateL ([Int], Int)
75 |     prune = do
76 |         is <- mapM (mapC . head) addends
77 |         k <- mapC (head result)
78 |         guard (all (/= 0) (k : is))
79 |         ns <- mapM toNumber addends
80 |         r <- toNumber result
81 |         return (ns, r)
82 | 
83 | -- ["send", "more"] "money"
84 | -- ["pink", "brown"] "ivory"
85 | -- ["IO", "TITAN", "URANUS"] "CHARON"
86 | -- ["ONE", "TWO", "FIVE", "NINE", "ELEVEN", "TWELVE", "FIFTY"] "NINETY"
87 | main = do
88 |     let lst = evalStateT (solve ["ONE", "TWO", "FIVE", "NINE", "ELEVEN", "TWELVE", "FIFTY"] "NINETY") ([0..9], M.empty)
89 |         zero = sum $ fmap (\(as, r) -> sum as - r) lst
90 |     print zero
91 |     print lst
92 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # MoreMoney
2 | Constraing solving using functional methods in C++, Haskell, and Scala/Scalaz. 
3 | See the [series of blog posts](http://bartoszmilewski.com/2015/05/11/using-monads-in-c-to-solve-constraints-1-the-list-monad/).
4 | 
5 | Inspired by [Justin Le's blog post](http://blog.jle.im/entry/unique-sample-drawing-searches-with-list-and-statet) and Douglas M. Auclair's article [MonadPlus: What a Super Monad!](https://wiki.haskell.org/wikiupload/6/6a/TMR-Issue11.pdf) in the Monad Reader.
6 | 


--------------------------------------------------------------------------------
/Scala/build.sbt:
--------------------------------------------------------------------------------
1 | name := "send-more-money"
2 | version := "1.0"
3 | 
4 | scalaVersion := "2.11.6"
5 | libraryDependencies += "org.scalaz" %% "scalaz-core" % "7.1.3"
6 | 


--------------------------------------------------------------------------------
/Scala/src/main/scala/SendMoreMoney.scala:
--------------------------------------------------------------------------------
 1 | import scalaz._, Scalaz._
 2 | 
 3 | object SendMoreMoney extends App {
 4 | 
 5 |   type StateL[A] = StateT[List, List[Int], A]
 6 | 
 7 |   def select[A](xs: List[A]): List[(List[A], A)] =
 8 |     xs map { x => (xs.filterNot(_ == x), x) }
 9 | 
10 |   def go(chars: List[Char], subst: Map[Char, Int])(i: Int): StateL[(Int, Int, Int)] =
11 |     chars match {
12 |       case c :: Nil => prune(subst + (c -> i))
13 |       case c :: cs  => StateT(select[Int]) >>= go(cs, subst + (c -> i))
14 |     }
15 | 
16 |   def prune(charToDigit: Map[Char, Int]): StateL[(Int, Int, Int)] = for {
17 |     _ <- (charToDigit('m') == 0).prevent[StateL](())
18 |     _ <- (charToDigit('s') == 0).prevent[StateL](())
19 |     send = "send" map charToDigit reduce (_ * 10 + _)
20 |     more = "more" map charToDigit reduce (_ * 10 + _)
21 |     money = "money" map charToDigit reduce (_ * 10 + _)
22 |     _ <- (send + more == money).guard[StateL](())
23 |   } yield (send, more, money)
24 | 
25 |   def solutions: StateL[(Int, Int, Int)] =
26 |     StateT(select[Int]) >>= go("sendmoremoney".toList.distinct, Map.empty)
27 | 
28 |   solutions.eval(0 |-> 9).head |> println
29 | }
30 | 


--------------------------------------------------------------------------------
/Simple/List.h:
--------------------------------------------------------------------------------
  1 | #if ! defined(LIST_H)
  2 | #define LIST_H
  3 | 
  4 | #include <cassert>
  5 | #include <memory>
  6 | #include <functional>
  7 | #include <initializer_list>
  8 | #include <iostream> // print
  9 | 
 10 | template<class T> class FwdListIter;
 11 | 
 12 | template<class T>
 13 | class List
 14 | {
 15 |     struct Item
 16 |     {
 17 |         Item(T v, std::shared_ptr<const Item> tail)
 18 |         : _val(v), _next(std::move(tail))
 19 |         {}
 20 |         // singleton
 21 |         explicit Item(T v) : _val(v) {}
 22 |         T _val;
 23 |         std::shared_ptr<const Item> _next;
 24 |     };
 25 |     friend Item;
 26 |     explicit List(std::shared_ptr<const Item> items)
 27 |         : _head(std::move(items)) {}
 28 | public:
 29 |     // Empty list
 30 |     List() {}
 31 |     // Cons
 32 |     List(T v, List const & tail)
 33 |         : _head(std::make_shared<Item>(v, tail._head)) {}
 34 |     // Singleton
 35 |     explicit List(T v) : _head(std::make_shared<Item>(v)) {}
 36 |     // From initializer list
 37 |     List(std::initializer_list<T> init)
 38 |     {
 39 |         for (auto it = std::rbegin(init); it != std::rend(init); ++it)
 40 |         {
 41 |             _head = std::make_shared<Item>(*it, _head);
 42 |         }
 43 |     }
 44 | 
 45 |     bool isEmpty() const { return !_head; }
 46 |     T front() const
 47 |     {
 48 |         assert(!isEmpty());
 49 |         return _head->_val;
 50 |     }
 51 |     List popped_front() const
 52 |     {
 53 |         assert(!isEmpty());
 54 |         return List(_head->_next);
 55 |     }
 56 |     // Additional utilities
 57 |     List pushed_front(T v) const
 58 |     {
 59 |         return List(v, *this);
 60 |     }
 61 |     List take(int n)
 62 |     {
 63 |         if (n <= 0 || isEmpty()) return List();
 64 |         return popped_front().take(n - 1).pushed_front(front());
 65 |     }
 66 | private:
 67 |     std::shared_ptr<const Item> _head;
 68 | };
 69 | 
 70 | template<class T, class F>
 71 | auto fmap(F f, List<T> lst) -> List<decltype(f(lst.front()))>
 72 | {
 73 |     using U = decltype(f(lst.front()));
 74 |     static_assert(std::is_convertible<F, std::function<U(T)>>::value,
 75 |         "fmap requires a function type U(T)");
 76 |     List<U> result;
 77 |     forEach(lst, [&](T x) {
 78 |         result = result.pushed_front(f(x));
 79 |     });
 80 |     return result;
 81 | }
 82 | 
 83 | template<class T>
 84 | List<T> concat(List<T> const & a, List<T> const & b)
 85 | {
 86 |     if (a.isEmpty())
 87 |         return b;
 88 |     return List<T>(a.front(), concat(a.popped_front(), b));
 89 | }
 90 | 
 91 | template<class T>
 92 | List<T> concatAll(List<List<T>> const & xss)
 93 | {
 94 |     List<T> result;
 95 |     forEach(xss, [&](List<T> const & xs){
 96 |         forEach(xs, [&](T const & e) {
 97 |             result = result.pushed_front(e);
 98 |         });
 99 |     });
100 |     return result;
101 | }
102 | 
103 | // consumes the list when called: 
104 | // forEach(std::move(lst), f);
105 | 
106 | template<class T, class F>
107 | void forEach(List<T> lst, F f)
108 | {
109 |     static_assert(std::is_convertible<F, std::function<void(T)>>::value,
110 |         "forEach requires a function type void(T)");
111 |     while (!lst.isEmpty()) {
112 |         f(lst.front());
113 |         lst = lst.popped_front();
114 |     }
115 | }
116 | 
117 | template<class T>
118 | std::ostream& operator<<(std::ostream& os, List<T> const & lst)
119 | {
120 |     os << "[";
121 |     forEach(lst, [&os](T v) {
122 |         os << v << " ";
123 |     });
124 |     os << "]";
125 |     return os;
126 | }
127 | 
128 | #endif
129 | 


--------------------------------------------------------------------------------
/Simple/MoreMoney.cpp:
--------------------------------------------------------------------------------
  1 | #include "StateList.h"
  2 | #include <vector>
  3 | using namespace std;
  4 | 
  5 | // select ::[a] ->[(a, [a])]
  6 | // select[] = []
  7 | // select(x:xs) = (x, xs) : [(y, x:ys) | (y, ys) <-select xs]
  8 | 
  9 | template<class A>
 10 | PairList<A> select(List<A> lst)
 11 | {
 12 |     if (lst.isEmpty())
 13 |         return PairList<A>();
 14 | 
 15 |     A       x = lst.front();
 16 |     List<A> xs = lst.popped_front();
 17 | 
 18 |     auto result = List<pair<A, State>>();
 19 |     forEach(select(xs), [x, &result](pair<A, List<A>> const & p)
 20 |     {
 21 |         A       y = p.first;
 22 |         List<A> ys = p.second;
 23 |         auto y_xys = make_pair(y, ys.pushed_front(x));
 24 |         result = result.pushed_front(y_xys);
 25 |     });
 26 | 
 27 |     return result.pushed_front(make_pair(x, xs));
 28 | }
 29 | 
 30 | /*
 31 | // asNumber :: [Int] -> Int
 32 | // asNumber = foldl(\t o->t * 10 + o) 0
 33 | int asNumber(List<int> const & lst)
 34 | {
 35 |     return foldl([](int acc, int d) {
 36 |         return acc * 10 + d;
 37 |     }, 0, lst);
 38 | }
 39 | */
 40 | int asNumber(vector<int> const & v)
 41 | {
 42 |     int acc = 0;
 43 |     for (auto i : v)
 44 |     {
 45 |         acc = 10 * acc + i;
 46 |     }
 47 |     return acc;
 48 | }
 49 | 
 50 | 
 51 | StateList<pair<int, int>> testBind()
 52 | {
 53 |     StateList<int> st = &select<int>;
 54 |     return mbind(st, [st](int x) {
 55 |         return mbind(st, [x](int y) {
 56 |             return mreturn(make_pair(x, y));
 57 |         });
 58 |     });
 59 | }
 60 | 
 61 | StateList<int> testThen()
 62 | {
 63 |     return mthen(mzero<int>(), []() {
 64 |         cout << "Ignoring\n";
 65 |         return mreturn(42);
 66 |     });
 67 | }
 68 | 
 69 | StateList<int> testGuard()
 70 | {
 71 |     StateList<int> st = &select<int>;
 72 |     return mbind(st, [](int x) {
 73 |         return mthen(guard(x > 2), [x]() {
 74 |             return mreturn(x);
 75 |         });
 76 |     });
 77 | 
 78 | }
 79 | 
 80 |     //s <-StateList select
 81 |     //e <-StateList select
 82 |     //n <-StateList select
 83 |     //d <-StateList select
 84 |     //m <-StateList select
 85 |     //o <-StateList select
 86 |     //r <-StateList select
 87 |     //y <-StateList select
 88 |     //guard $ s /= 0 && m /= 0
 89 |     //let send = asNumber[s, e, n, d]
 90 |     //more = asNumber[m, o, r, e]
 91 |     //money = asNumber[m, o, n, e, y]
 92 |     //guard $ send + more == money
 93 |     //return (send, more, money)
 94 | 
 95 | 
 96 | StateList<tuple<int, int, int>> solve()
 97 | {
 98 |     StateList<int> sel = &select<int>;
 99 | 
100 |     return mbind(sel, [=](int s) {
101 |     return mbind(sel, [=](int e) {
102 |     return mbind(sel, [=](int n) {
103 |     return mbind(sel, [=](int d) {
104 |     return mbind(sel, [=](int m) {
105 |     return mbind(sel, [=](int o) {
106 |     return mbind(sel, [=](int r) {
107 |     return mbind(sel, [=](int y) {
108 |         return mthen(guard(s != 0 && m != 0), [=]() {
109 |             int send  = asNumber(vector<int>{s, e, n, d});
110 |             int more  = asNumber(vector<int>{m, o, r, e});
111 |             int money = asNumber(vector<int>{m, o, n, e, y});
112 |             return mthen(guard(send + more == money), [=]() {
113 |                 return mreturn(make_tuple(send, more, money));
114 |             });
115 |         });
116 |     });});});});});});});});
117 | }
118 | 
119 | 
120 | 
121 | int main()
122 | {
123 |     List<int> lst{ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 };
124 |     /*
125 |     StateList<int> st = &select<int>;
126 |     PairList<int> sel = runStateList(st, lst);
127 |     cout << sel;
128 |     cout << endl;
129 |     cout << evalStateList(st, lst);
130 |     cout << endl;
131 |     cout << runStateList(mreturn<int>(42), lst);
132 |     cout << endl;
133 |     cout << evalStateList(testBind(), lst);
134 |     cout << endl;
135 |     cout << evalStateList(testThen(), lst);
136 |     cout << endl;
137 |     cout << evalStateList(testGuard(), lst);
138 |     cout << endl;
139 |     cout << asNumber(lst);
140 |     cout << endl;
141 |     */
142 |     cout << evalStateList(solve(), lst);
143 |     return 0;
144 | }


--------------------------------------------------------------------------------
/Simple/StateList.h:
--------------------------------------------------------------------------------
  1 | #include "List.h"
  2 | #include <functional>
  3 | #include <tuple>
  4 | 
  5 | using namespace std;
  6 | 
  7 | using State = List<int>;
  8 | 
  9 | // newtype StateList s a = StateList (s -> [(a, s)])
 10 | template<class A>
 11 | using PairList = List<pair<A, State>>;
 12 | 
 13 | template<class A> 
 14 | using StateList = function<PairList<A>(State)>;
 15 | 
 16 | // runStateList :: StateList s a -> s -> [(a, s)]
 17 | // runStateList(StateList g) s = g s
 18 | 
 19 | template<class A>
 20 | PairList<A> runStateList(StateList<A> st, State s)
 21 | {
 22 |     return st(s);
 23 | }
 24 | 
 25 | // evalStateList::StateList s a->s ->[a]
 26 | // evalStateList(StateList g) s = fmap fst(g s)
 27 | template<class A>
 28 | List<A> evalStateList(StateList<A> st, State s)
 29 | {
 30 |     return fmap([](pair<A, State> const & p)->A {
 31 |         return p.first;
 32 |     }, st(s));
 33 | }
 34 | 
 35 | // return x = StateList(\s ->[(x, s)])
 36 | template<class A>
 37 | StateList<A> mreturn(A a)
 38 | {
 39 |     return [a](State s) { return PairList<A>(make_pair(a, s)); };
 40 | }
 41 | 
 42 | // (StateList g) >>= k = StateList(\s->concat $ fmap(\(a, s') -> runStateList (k a) s') (g s))
 43 | 
 44 | // k is a function<StateList<S, B>(A)>
 45 | // mbind returns StateList<S, B> 
 46 | 
 47 | template<class A, class F>
 48 | auto mbind(StateList<A> g, F k) -> decltype(k(g(State()).front().first))
 49 | {
 50 |     return [g, k](State s) {
 51 |         PairList<A> plst = g(s);
 52 |         //List<PairList<B>> 
 53 |         auto lst2 = fmap([k](pair<A, State> const & p) {
 54 |             A a = p.first;
 55 |             State s1 = p.second;
 56 |             auto ka = k(a);
 57 |             auto result = runStateList(ka, s1);
 58 |             return result;
 59 |         }, plst);
 60 |         return concatAll(lst2);
 61 |     };
 62 | }
 63 | 
 64 | // A version of mbind with a continuation that ignores its argument
 65 | template<class A, class F>
 66 | auto mthen(StateList<A> g, F k) -> decltype(k())
 67 | {
 68 |     return [g, k](State s) {
 69 |         PairList<A> plst = g(s);
 70 |         auto lst2 = fmap([k](pair<A, State> const & p) {
 71 |             State s1 = p.second;
 72 |             auto ka = k();
 73 |             auto result = runStateList(ka, s1);
 74 |             return result;
 75 |         }, plst);
 76 |         return concatAll(lst2);
 77 |     };
 78 | }
 79 | 
 80 | // mzero = StateList(\s ->[])
 81 | template<class A>
 82 | StateList<A> mzero()
 83 | {
 84 |     return[](State s) {
 85 |         return PairList<A>();
 86 |     };
 87 | }
 88 | 
 89 | StateList<void*> guard(bool b)
 90 | {
 91 |     if (b) {
 92 |         return [](State s) {
 93 |             return List<pair<void*, State>>(make_pair(nullptr, s));
 94 |         };
 95 |     }
 96 |     else
 97 |         return mzero<void*>();
 98 | }
 99 | 
100 | template<class S, class A>
101 | std::ostream& operator<<(std::ostream& os, pair<A, S> const & p)
102 | {
103 |     os << "(";
104 |     os << p.first << ", " << p.second;
105 |     os << ")";
106 |     return os;
107 | }
108 | 
109 | template<class A, class B, class C>
110 | std::ostream& operator<<(std::ostream& os, tuple<A, B, C> const & t)
111 | {
112 |     os << "(";
113 |     os << get<0>(t) << ", " << get<1>(t) << ", " << get<2>(t);
114 |     os << ")";
115 |     return os;
116 | }
117 | 
118 | 


--------------------------------------------------------------------------------
/StateMonad/List.h:
--------------------------------------------------------------------------------
  1 | #if ! defined(LIST_H)
  2 | #define LIST_H
  3 | 
  4 | #include <cassert>
  5 | #include <memory>
  6 | #include <functional>
  7 | #include <initializer_list>
  8 | #include <iostream> // print
  9 | 
 10 | template<class T> class FwdListIter;
 11 | 
 12 | template<class T>
 13 | class List
 14 | {
 15 |     struct Item
 16 |     {
 17 |         Item(T v, std::shared_ptr<const Item> tail)
 18 |         : _val(v), _next(std::move(tail))
 19 |         {}
 20 |         // singleton
 21 |         explicit Item(T v) : _val(v) {}
 22 |         T _val;
 23 |         std::shared_ptr<const Item> _next;
 24 |     };
 25 |     friend Item;
 26 |     explicit List(std::shared_ptr<const Item> items)
 27 |         : _head(std::move(items)) {}
 28 | public:
 29 |     // Empty list
 30 |     List() {}
 31 |     // Cons
 32 |     List(T v, List const & tail)
 33 |         : _head(std::make_shared<Item>(v, tail._head)) {}
 34 |     // Singleton
 35 |     explicit List(T v) : _head(std::make_shared<Item>(v)) {}
 36 |     // From initializer list
 37 |     List(std::initializer_list<T> init)
 38 |     {
 39 |         for (auto it = std::rbegin(init); it != std::rend(init); ++it)
 40 |         {
 41 |             _head = std::make_shared<Item>(*it, _head);
 42 |         }
 43 |     }
 44 | 
 45 |     bool isEmpty() const { return !_head; }
 46 |     T front() const
 47 |     {
 48 |         assert(!isEmpty());
 49 |         return _head->_val;
 50 |     }
 51 |     List popped_front() const
 52 |     {
 53 |         assert(!isEmpty());
 54 |         return List(_head->_next);
 55 |     }
 56 |     // Additional utilities
 57 |     List pushed_front(T v) const
 58 |     {
 59 |         return List(v, *this);
 60 |     }
 61 |     List take(int n)
 62 |     {
 63 |         if (n <= 0 || isEmpty()) return List();
 64 |         return popped_front().take(n - 1).pushed_front(front());
 65 |     }
 66 | private:
 67 |     std::shared_ptr<const Item> _head;
 68 | };
 69 | 
 70 | template<class T, class F>
 71 | auto fmap(F f, List<T> lst) -> List<decltype(f(lst.front()))>
 72 | {
 73 |     using U = decltype(f(lst.front()));
 74 |     static_assert(std::is_convertible<F, std::function<U(T)>>::value,
 75 |         "fmap requires a function type U(T)");
 76 |     List<U> result;
 77 |     forEach(lst, [&](T x) {
 78 |         result = result.pushed_front(f(x));
 79 |     });
 80 |     return result;
 81 | }
 82 | 
 83 | template<class T>
 84 | List<T> concat(List<T> const & a, List<T> const & b)
 85 | {
 86 |     if (a.isEmpty())
 87 |         return b;
 88 |     return List<T>(a.front(), concat(a.popped_front(), b));
 89 | }
 90 | 
 91 | template<class T>
 92 | List<T> concatAll(List<List<T>> const & xss)
 93 | {
 94 |     List<T> result;
 95 |     forEach(xss, [&](List<T> const & xs){
 96 |         forEach(xs, [&](T const & e) {
 97 |             result = result.pushed_front(e);
 98 |         });
 99 |     });
100 |     return result;
101 | }
102 | 
103 | // consumes the list when called: 
104 | // forEach(std::move(lst), f);
105 | 
106 | template<class T, class F>
107 | void forEach(List<T> lst, F f)
108 | {
109 |     static_assert(std::is_convertible<F, std::function<void(T)>>::value,
110 |         "forEach requires a function type void(T)");
111 |     while (!lst.isEmpty()) {
112 |         f(lst.front());
113 |         lst = lst.popped_front();
114 |     }
115 | }
116 | 
117 | template<class T>
118 | std::ostream& operator<<(std::ostream& os, List<T> const & lst)
119 | {
120 |     os << "[";
121 |     forEach(lst, [&os](T v) {
122 |         os << v << " ";
123 |     });
124 |     os << "]";
125 |     return os;
126 | }
127 | 
128 | #endif
129 | 


--------------------------------------------------------------------------------
/StateMonad/State.cpp:
--------------------------------------------------------------------------------
 1 | #include <cassert>
 2 | #include <tuple>
 3 | #include "List.h"
 4 | using namespace std;
 5 | 
 6 | using State = List<int>;
 7 | 
 8 | // To retrieve A from Plan<A> pl
 9 | // decltype(pl(State()).first)
10 | template<class A>
11 | using Plan = function<pair<A, State>(State)>;
12 | 
13 | template<class A>
14 | pair<A, State> runPlan(Plan<A> pl, State s)
15 | {
16 |     return pl(s);
17 | }
18 | 
19 | template<class A>
20 | A evalPlan(Plan<A> pl, State s)
21 | {
22 |     return runState(pl, s).first;
23 | }
24 | 
25 | template<class A>
26 | Plan<A> mreturn(A a)
27 | {
28 |     return [a](State s) { return make_pair(a, s); };
29 | }
30 | 
31 | template<class A, class F>
32 | auto mbind(Plan<A> pl, F k) -> decltype(k(pl(State()).first))
33 | {
34 |     using B = decltype(k(pl(State()).first)(State()).first);
35 |     static_assert(std::is_convertible<
36 |         F, std::function<Plan<B>(A)>> ::value,
37 |         "mbind requires a function type Plan<B>(A)");
38 | 
39 |     return [pl, k](State s) {
40 |         pair<A, State> ps = runPlan(pl, s);
41 |         Plan<B> plB = k(ps.first);
42 |         return runPlan(plB, ps.second);
43 |     };
44 | }
45 | 
46 | // A version of mbind with a continuation that ignores its argument
47 | template<class A, class F>
48 | auto mthen(Plan<A> pl, F k) -> decltype(k())
49 | {
50 |     using B = decltype(k()(State()).first);
51 |     static_assert(std::is_convertible<
52 |         F, std::function<Plan<B>()>> ::value,
53 |         "mthen requires a function type Plan<B>()");
54 | 
55 |     return [pl, k](State s) {
56 |         pair<A, State> ps = pl(s);
57 |         // ignore ps.first
58 |         Plan<B> plB = k();
59 |         return runPlan(plB, ps.second);
60 |     };
61 | }
62 | 
63 | template<class S, class A>
64 | std::ostream& operator<<(std::ostream& os, pair<A, S> const & p)
65 | {
66 |     os << "(";
67 |     os << p.first << ", " << p.second;
68 |     os << ")";
69 |     return os;
70 | }
71 | 
72 | pair<int, List<int>> select(List<int> lst)
73 | {
74 |     int i = lst.front();
75 |     return make_pair(i, lst.popped_front());
76 | }
77 | 
78 | Plan<int> sel = &select;
79 | 
80 | int main()
81 | {
82 |     List<int> st{ 1, 2, 3 };
83 |     Plan<pair<int, int>> pl = 
84 |         mbind(sel, [=](int i) { return
85 |         mbind(sel, [=](int j) { return
86 |         mreturn(make_pair(i, j));
87 |     });
88 |     });
89 |     cout << runPlan(pl, st) << endl;
90 |     return 0;
91 | }
92 | 


--------------------------------------------------------------------------------