You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@tuscany.apache.org by js...@apache.org on 2009/10/11 02:01:05 UTC

svn commit: r823981 - in /tuscany/cpp/sca: kernel/ modules/eval/ test/store-function/ test/store-object/

Author: jsdelfino
Date: Sun Oct 11 00:01:04 2009
New Revision: 823981

URL: http://svn.apache.org/viewvc?rev=823981&view=rev
Log:
Some code cleanup, removed unused functions, changed == empty-list to isNil to avoid unnecessary construction of empty lists, replaced some casts by generic declarations. Added simple maybe, failable and state monad classes to help return optional objects or failures and carry state around. Added utility functions to zip and unzip list.

Added:
    tuscany/cpp/sca/kernel/monad.hpp
Modified:
    tuscany/cpp/sca/kernel/function.hpp
    tuscany/cpp/sca/kernel/kernel-test.cpp
    tuscany/cpp/sca/kernel/list.hpp
    tuscany/cpp/sca/kernel/parallel.hpp
    tuscany/cpp/sca/kernel/value.hpp
    tuscany/cpp/sca/kernel/xml.hpp
    tuscany/cpp/sca/modules/eval/environment.hpp
    tuscany/cpp/sca/modules/eval/eval.hpp
    tuscany/cpp/sca/modules/eval/primitive.hpp
    tuscany/cpp/sca/modules/eval/read.hpp
    tuscany/cpp/sca/test/store-function/cart.hpp
    tuscany/cpp/sca/test/store-object/cart.hpp

Modified: tuscany/cpp/sca/kernel/function.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/kernel/function.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/kernel/function.hpp (original)
+++ tuscany/cpp/sca/kernel/function.hpp Sun Oct 11 00:01:04 2009
@@ -174,13 +174,6 @@
 }
 
 /**
- * Creates a lambda function from a pointer to a function.
- */
-template<typename R, typename... P> lambda<R(P...)> makeLambda(const R (* const f)(P...)) {
-    return lambda<R(P...)>(f);
-}
-
-/**
  * Curry a lambda function.
  */
 template<typename R, typename T, typename... P> class curried {
@@ -198,7 +191,7 @@
 };
 
 template<typename R, typename T, typename... P> const lambda<R(P...)> curry(const lambda<R(T, P...)>& f, const T& t) {
-    return (lambda<R(P...)>)curried<R, T, P...>(f, t);
+    return curried<R, T, P...>(f, t);
 }
 
 template<typename R, typename T, typename U, typename... P> const lambda<R(P...)> curry(const lambda<R(T, U, P...)>& f, const T& t, const U& u) {
@@ -212,9 +205,9 @@
 /**
  * A lambda function that returns the given value.
  */
-template<typename T> class unitReturn {
+template<typename T> class returnResult {
 public:
-    unitReturn(const T& v) :
+    returnResult(const T& v) :
         v(v) {
     }
     const T operator()() const {
@@ -224,8 +217,8 @@
     const T v;
 };
 
-template<typename T> const lambda<T()> unit(const T& v) {
-    return lambda<T()> (unitReturn<T> (v));
+template<typename T> const lambda<T()> result(const T& v) {
+    return returnResult<T> (v);
 }
 
 }

Modified: tuscany/cpp/sca/kernel/kernel-test.cpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/kernel/kernel-test.cpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/kernel/kernel-test.cpp (original)
+++ tuscany/cpp/sca/kernel/kernel-test.cpp Sun Oct 11 00:01:04 2009
@@ -35,6 +35,7 @@
 #include "parallel.hpp"
 #include "value.hpp"
 #include "xml.hpp"
+#include "monad.hpp"
 
 namespace tuscany {
 
@@ -52,18 +53,26 @@
     return x * x;
 }
 
-bool testFunction() {
+int mapLambda(lambda<int(int)> f, int v) {
+    return f(v);
+}
+
+bool testLambda() {
     const lambda<int(int)> sq(square);
     assert(sq(2) == 4);
+    assert(mapLambda(sq, 2) == 4);
+    assert(mapLambda(square, 2) == 4);
 
-    const lambda<int(int i)> incf(inc(10));
+    const lambda<int(int)> incf(inc(10));
     assert(incf(1) == 11);
+    assert(mapLambda(incf, 1) == 11);
+    assert(mapLambda(inc(10), 1) == 11);
     return true;
 }
 
-bool testFunctionGC() {
+bool testLambdaGC() {
     resetLambdaCounters();
-    testFunction();
+    testLambda();
     assert(countLambdas == 0);
     return true;
 }
@@ -171,9 +180,9 @@
 }
 
 bool testMap() {
-    assert(isNil(map((lambda<int(int)>)square, list<int>())));
+    assert(isNil(map<int, int>(square, list<int>())));
 
-    const list<int> m = map((lambda<int(int)> )square, makeList(2, 3));
+    const list<int> m = map<int, int>(square, makeList(2, 3));
     assert(car(m) == 4);
     assert(car(cdr(m)) == 9);
 
@@ -198,9 +207,8 @@
 }
 
 bool testFilter() {
-    lambda<bool(int)> f(isPositive);
-    assert(car(filter(f, makeList(1, -1, 2, -2))) == 1);
-    assert(cadr(filter(f, makeList(1, -1, 2, -2))) == 2);
+    assert(car(filter<int>(isPositive, makeList(1, -1, 2, -2))) == 1);
+    assert(cadr(filter<int>(isPositive, makeList(1, -1, 2, -2))) == 2);
     return true;
 }
 
@@ -219,6 +227,23 @@
     return true;
 }
 
+bool testAssoc() {
+    const list<list<std::string> > l = makeList(makeList<std::string>("x", "X"), makeList<std::string>("a", "A"), makeList<std::string>("y", "Y"), makeList<std::string>("a", "AA"));
+    assert(assoc<std::string>("a", l) == makeList<std::string>("a", "A"));
+    assert(isNil(assoc<std::string>("z", l)));
+    return true;
+}
+
+bool testZip() {
+    const list<std::string> k = makeList<std::string>("x", "a", "y", "a");
+    const list<std::string> v = makeList<std::string>("X", "A", "Y", "AA");
+    const list<list<std::string> > z = makeList(k, v);
+    const list<list<std::string> > u = makeList(makeList<std::string>("x", "X"), makeList<std::string>("a", "A"), makeList<std::string>("y", "Y"), makeList<std::string>("a", "AA"));
+    assert(zip(k, v) == u);
+    assert(unzip(u) == z);
+    return true;
+}
+
 bool testTokenize() {
     assert(tokenize("/", "aaa/bbb/ccc/ddd") == makeList<std::string>("aaa", "bbb", "ccc", "ddd"));
     assert(tokenize("/", "/bbb/ccc/ddd") == makeList<std::string>("", "bbb", "ccc", "ddd"));
@@ -245,12 +270,12 @@
     //printLambdaCounters();
     //printListCounters();
 
-    assert(1001 == length(map(lambda<double(double)>(testSeqMap), s)));
+    assert(1001 == length(map<double, double>(testSeqMap, s)));
 
     assert(801 == length(member(200.0, s)));
     assert(201 == length(member(200.0, reverse(s))));
 
-    assert(1001 == reduce(lambda<double(double, double)>(testSeqReduce), 0.0, s));
+    assert(1001 == (reduce<double, double>(testSeqReduce, 0.0, s)));
     //printLambdaCounters();
     //printListCounters();
 
@@ -299,7 +324,7 @@
         gettimeofday(&start, NULL);
 
         list<double> s = seq(0.0, 999.0);
-        list<double> r = map((lambda<double(double)> )fib, s);
+        list<double> r = map<double, double>(fib, s);
         assert(1000 == length(r));
 
         gettimeofday(&end, NULL);
@@ -434,7 +459,7 @@
     assert(elementName(composite) == "composite");
     assert(!elementHasText(composite));
 
-    assert(attributeText(car(filter(lambda<bool(value)>(isName), elementChildren(composite)))) == "currency");
+    assert(attributeText(car(filter<value>(isName, elementChildren(composite)))) == "currency");
     return true;
 }
 
@@ -449,21 +474,122 @@
 
     const list<value> currency = readXML(il);
     std::ostringstream os;
-    lambda<std::ostringstream*(std::ostringstream*, std::string)> writer(xmlWriter);
-    writeXML(writer, &os, currency);
+    writeXML<std::ostringstream*>(xmlWriter, &os, currency);
     assert(os.str() == currencyXML);
 
     assert(writeXML(currency) == il);
     return true;
 }
 
+const id<int> idF(const int v) {
+    return v * 2;
+}
+
+const id<int> idG(const int v) {
+    return v * 3;
+}
+
+const id<int> idH(const int v) {
+    return idF(v) >> idG;
+}
+
+bool testIdMonad() {
+    const id<int> m(2);
+    assert(m >> idF == idF(2));
+    assert(m >> unit<int>() == m);
+    assert(m >> idF >> idG == m >> idH);
+    return true;
+}
+
+const maybe<int> maybeF(const int v) {
+    return v * 2;
+}
+
+const maybe<int> maybeG(const int v) {
+    return v * 3;
+}
+
+const maybe<int> maybeH(const int v) {
+    return maybeF(v) >> maybeG;
+}
+
+bool testMaybeMonad() {
+    const maybe<int> m(2);
+    assert(m >> maybeF == maybeF(2));
+    assert((m >> just<int>()) == m);
+    assert(m >> maybeF >> maybeG == m >> maybeH);
+
+    assert(maybe<int>() >> maybeF >> maybeG == maybe<int>());
+    return true;
+}
+
+const failable<int, std::string> failableF(const int v) {
+    return v * 2;
+}
+
+const failable<int, std::string> failableG(const int v) {
+    return v * 3;
+}
+
+const failable<int, std::string> failableH(const int v) {
+    return failableF(v) >> failableG;
+}
+
+bool testFailableMonad() {
+    const failable<int, std::string> m(2);
+    assert(m >> failableF == failableF(2));
+    assert((m >> success<int, std::string>()) == m);
+    assert(m >> failableF >> failableG == m >> failableH);
+
+    failable<int, std::string> ooops("ooops");
+    assert(ooops >> failableF >> failableG == ooops);
+    return true;
+}
+
+struct tickInc {
+    const double v;
+    tickInc(const double v) : v(v) {
+    }
+    const svp<int, double> operator()(int s) const {
+        return svp<int, double>(s + 1, v);
+    }
+};
+
+const state<int, double> tick(const double v) {
+    return transformer<int, double>(tickInc(v));
+}
+
+const state<int, double> stateF(const double v) {
+    return result<int, double>(v * 2.0) >> tick;
+}
+
+const state<int, double> stateG(const double v) {
+    return result<int, double>(v + 5);
+}
+
+const state<int, double> stateH(const double v) {
+    return stateF(v) >> stateG;
+}
+
+bool testStateMonad() {
+    const lambda<state<int, double>(double)> r(result<int, double>);
+
+    state<int, double> m = result<int, double>(2.0);
+    assert((m >> stateF)(0) == stateF(2.0)(0));
+    assert(1 == (int)(m >> stateF)(0));
+    assert((m >> r)(0) == m(0));
+    assert((m >> stateF >> stateG)(0) == (m >> stateH)(0));
+
+    return true;
+}
+
 }
 
 int main() {
     std::cout << "Testing..." << std::endl;
 
-    tuscany::testFunction();
-    tuscany::testFunctionGC();
+    tuscany::testLambda();
+    tuscany::testLambdaGC();
     tuscany::testCons();
     tuscany::testListGC();
     tuscany::testOut();
@@ -476,6 +602,8 @@
     tuscany::testFilter();
     tuscany::testMember();
     tuscany::testReverse();
+    tuscany::testAssoc();
+    tuscany::testZip();
     tuscany::testTokenize();
     tuscany::testSeq();
     tuscany::testValue();
@@ -485,6 +613,10 @@
     tuscany::testWorker();
     tuscany::testReadXML();
     tuscany::testWriteXML();
+    tuscany::testIdMonad();
+    tuscany::testMaybeMonad();
+    tuscany::testFailableMonad();
+    tuscany::testStateMonad();
 
     std::cout << "OK" << std::endl;
 

Modified: tuscany/cpp/sca/kernel/list.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/kernel/list.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/kernel/list.hpp (original)
+++ tuscany/cpp/sca/kernel/list.hpp Sun Oct 11 00:01:04 2009
@@ -123,7 +123,7 @@
  * Write a list to an output stream.
  */
 template<typename X> std::ostream& operator<<(std::ostream& out, const list<X>& l) {
-    if(l == list<X> ())
+    if(isNil(l))
         return out << "()";
     return out << "(" << car(l) << ", " << cdr(l) << ")";
 }
@@ -139,14 +139,14 @@
  * Construct a list from a value and a cdr list.
  */
 template<typename T> const list<T> cons(const T& car, const list<T>& cdr) {
-    return list<T> (car, unit(cdr));
+    return list<T> (car, result(cdr));
 }
 
 /**
  * Construct a list of one value.
  */
 template<typename T> const list<T> makeList(const T& car) {
-    return list<T> (car, unit(list<T> ()));
+    return list<T> (car, result(list<T> ()));
 }
 
 /**
@@ -245,14 +245,14 @@
     if(isNil(a))
         return fb();
 
-    return cons(car(a), lambda<list<T> ()> (appendCdr<T> (cdr(a), fb)));
+    return cons<T>(car(a), appendCdr<T> (cdr(a), fb));
 }
 
 /**
  * Appends two lists.
  */
 template<typename T> const list<T> append(const list<T>&a, const list<T>& b) {
-    return append(a, unit(b));
+    return append(a, result(b));
 }
 
 /**
@@ -340,12 +340,12 @@
     if(start == end)
         return makeList(start);
     if(start < end)
-        return cons(start, lambda<list<T> ()> (seqGenerate<T> (start + 1, end)));
-    return cons(start, lambda<list<T> ()> (seqGenerate<T> (start - 1, end)));
+        return cons<T>(start, seqGenerate<T> (start + 1, end));
+    return cons<T>(start, seqGenerate<T> (start - 1, end));
 }
 
 /**
- * Equivalent of the list assoc function.
+ * Returns the first pair matching a key from a list of key value pairs.
  */
 template<typename T> const list<T> assoc(const T& k, const list<list<T> >& p) {
     if(isNil(p))
@@ -356,6 +356,34 @@
 }
 
 /**
+ * Returns a list of lists containing elements from two input lists.
+ */
+template<typename T> const list<list<T> > zip(const list<T>& a, const list<T>& b) {
+    if (isNil(a) || isNil(b))
+        return list<list<T> >();
+    return cons<list<T> >(makeList<T>(car(a), car(b)), zip(cdr(a), cdr(b)));
+}
+
+/**
+ * Converts a list of key value pairs to a list containing the list of keys and the list of values.
+ */
+template<typename T> const list<T> unzipKeys(const list<list<T> >& l) {
+    if (isNil(l))
+        return list<T>();
+    return cons(car(car(l)), unzipKeys(cdr(l)));
+}
+
+template<typename T> const list<T> unzipValues(const list<list<T> >& l) {
+    if (isNil(l))
+        return list<T>();
+    return cons(cadr(car(l)), unzipValues(cdr(l)));
+}
+
+template<typename T> const list<list<T> > unzip(const list<list<T> >& l) {
+    return makeList<list<T> >(unzipKeys(l), unzipValues(l));
+}
+
+/**
  * Pretty print a list.
  */
 template<typename T> std::ostream& print(const list<T>& l, std::ostream& os) {

Added: tuscany/cpp/sca/kernel/monad.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/kernel/monad.hpp?rev=823981&view=auto
==============================================================================
--- tuscany/cpp/sca/kernel/monad.hpp (added)
+++ tuscany/cpp/sca/kernel/monad.hpp Sun Oct 11 00:01:04 2009
@@ -0,0 +1,386 @@
+/*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements.  See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership.  The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License.  You may obtain a copy of the License at
+ *
+ *   http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied.  See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ */
+
+/* $Rev$ $Date$ */
+
+#ifndef tuscany_monad_hpp
+#define tuscany_monad_hpp
+
+/**
+ * Simple monad implementations.
+ */
+
+#include <string>
+#include <iostream>
+#include "function.hpp"
+
+namespace tuscany
+{
+
+/**
+ * Identity monad. Just wraps a value.
+ * To get the value in the monad, just cast it to the value type.
+ */
+template<typename V> class id {
+public:
+    id(const V& v) : v(v) {
+    }
+
+    operator const V() const {
+        return v;
+    }
+
+    const id<V>& operator=(const id<V>& m) {
+        if(this == &m)
+            return *this;
+        v = m.v;
+        return *this;
+    }
+
+    const bool operator!=(const id<V>& m) const {
+        return !this->operator==(m);
+    }
+
+    const bool operator==(const id<V>& m) const {
+        if (&m == this)
+            return true;
+        return v == m.v;
+    }
+
+private:
+    const V v;
+};
+
+/**
+ * Return an identity monad from a value.
+ */
+template<typename V> const id<V> makeUnit(const V& v) {
+    return id<V>(v);
+}
+
+template<typename V> const lambda<id<V>(V)> unit() {
+    return makeUnit<V>;
+}
+
+/**
+ * Bind a function to an identity monad. Pass the value in the monad to the function.
+ */
+template<typename R, typename V> const id<R> operator>>(const id<V>& m, const lambda<id<R>(V)>& f) {
+    return f(m);
+}
+
+template<typename R, typename V> const id<R> operator>>(const id<V>& m, const id<R> (* const f)(const V)) {
+    return f(m);
+}
+
+/**
+ * Maybe monad. Used to represent an optional value, which may be there or not.
+ * To get the value in the monad, just cast it to the value type.
+ */
+template<typename V> class maybe {
+public:
+    maybe(const V& v) : hasv(true), v(v) {
+    }
+
+    maybe() : hasv(false) {
+    }
+
+    operator const V() const {
+        return v;
+    }
+
+    const maybe<V>& operator=(const maybe<V>& m) {
+        if(this == &m)
+            return *this;
+        hasv = m.hasv;
+        if (hasv)
+            v = m.v;
+        return *this;
+    }
+
+    const bool operator!=(const maybe<V>& m) const {
+        return !this->operator==(m);
+    }
+
+    const bool operator==(const maybe<V>& m) const {
+        if (this == &m)
+            return true;
+        if (!hasv)
+            return !m.hasv;
+        return m.hasv && v == m.v;
+    }
+
+private:
+    const bool hasv;
+    V v;
+
+    template<typename A> friend const bool hasValue(const maybe<A>& m);
+};
+
+/**
+ * Return a maybe monad with a value in it.
+ */
+template<typename V> const maybe<V> makeJust(const V& v) {
+    return maybe<V>(v);
+}
+
+template<typename V> const lambda<maybe<V>(V)> just() {
+    return makeJust<V>;
+}
+
+/**
+ * Returns true if the monad contains a value.
+ */
+template<typename V> const bool hasValue(const maybe<V>& m) {
+    return m.hasv;
+}
+
+/**
+ * Bind a function to a maybe monad. Passes the value in the monad to the function
+ * if present, or does nothing if there's no value.
+ */
+template<typename R, typename V> const maybe<R> operator>>(const maybe<V>& m, const lambda<maybe<R>(V)>& f) {
+    if (!hasValue(m))
+        return m;
+    return f(m);
+}
+
+template<typename R, typename V> const maybe<R> operator>>(const maybe<V>& m, const maybe<R> (* const f)(const V)) {
+    if (!hasValue(m))
+        return m;
+    return f(m);
+}
+
+/**
+ * Failable monad. Used to represent either a success value or a failure.
+ * To get the value in the monad, just cast it to the value type.
+ * To get the failure in the monad, cast it to the failure type.
+ */
+template<typename V, typename F> class failable {
+public:
+    failable(const V& v) : hasv(true), v(v) {
+    }
+
+    failable(const F& f) : hasv(false), f(f) {
+    }
+
+    operator const V() const {
+        return v;
+    }
+
+    operator const F() const {
+        return f;
+    }
+
+    const failable<V, F>& operator=(const failable<V, F>& m) {
+        if(this == &m)
+            return *this;
+        hasv = m.hasv;
+        if (hasv)
+            v = m.v;
+        else
+            f = m.f;
+        return *this;
+    }
+
+    const bool operator!=(const failable<V, F>& m) const {
+        return !this->operator==(m);
+    }
+
+    const bool operator==(const failable<V, F>& m) const {
+        if (this == &m)
+            return true;
+        if (!hasv)
+            return !m.hasv && f == m.f;
+        return m.hasv && v == m.v;
+    }
+
+private:
+    const bool hasv;
+    V v;
+    F f;
+
+    template<typename A, typename B> friend const bool hasValue(const failable<A, B>& m);
+};
+
+/**
+ * Returns a failable monad with a success value in it.
+ */
+template<typename V, typename F> const failable<V, F> makeSuccess(const V& v) {
+    return failable<V, F>(v);
+}
+
+template<typename V, typename F> const lambda<failable<V, F>(V)> success() {
+    return makeSuccess<V, F>;
+}
+
+/**
+ * Returns true if the monad contains a value.
+ */
+template<typename V, typename F> const bool hasValue(const failable<V, F>& m) {
+    return m.hasv;
+}
+
+/**
+ * Bind a function to a failable monad. Passes the success value in the monad to the function
+ * if present, or does nothing if there's no value and a failure instead.
+ */
+template<typename R, typename FR, typename V, typename FV>
+const failable<R, FR> operator>>(const failable<V, FV>& m, const lambda<failable<R, FR>(V)>& f) {
+    if (!hasValue(m))
+        return m;
+    return f(m);
+}
+
+template<typename R, typename FR, typename V, typename FV>
+const failable<R, FR> operator>>(const failable<V, FV>& m, const failable<R, FR> (* const f)(const V)) {
+    if (!hasValue(m))
+        return m;
+    return f(m);
+}
+
+/**
+ * State + value pair data type used by the state monad.
+ */
+template<typename S, typename V> class svp {
+public:
+    svp(const S& s, const V& v) : s(s), v(v) {
+    }
+
+    operator const S() const {
+        return s;
+    }
+
+    operator const V() const {
+        return v;
+    }
+
+    const svp<S, V>& operator=(const svp<S, V>& p) {
+        if(this == &p)
+            return *this;
+        s = p.s;
+        v = p.v;
+        return *this;
+    }
+
+    const bool operator!=(const svp<S, V>& p) const {
+        return !this->operator==(p);
+    }
+
+    const bool operator==(const svp<S, V>& p) const {
+        if (this == &p)
+            return true;
+        return s == p.s && v == p.v;
+    }
+
+private:
+    const S s;
+    const V v;
+};
+
+/**
+ * State monad. Used to represent the combination of a state and a value.
+ * To get the state in the monad, just cast it to the state type.
+ * To get the value in the monad, just cast it to the value type.
+ */
+template<typename S, typename V> class state {
+public:
+    state(const lambda<svp<S, V>(S)>& f) : f(f) {
+    }
+
+    const svp<S, V> operator()(const S& s) const {
+        return f(s);
+    }
+
+    const state<S, V>& operator=(const state<S, V>& m) {
+        if(this == &m)
+            return *this;
+        f = m.f;
+        return *this;
+    }
+
+    const bool operator!=(const state<S, V>& m) const {
+        return !this->operator==(m);
+    }
+
+    const bool operator==(const state<S, V>& m) const {
+        if (this == &m)
+            return true;
+        return f == m.f;
+    }
+
+private:
+    const lambda<svp<S, V>(S)> f;
+};
+
+/**
+ * Return a state monad carrying a result value.
+ */
+template<typename S, typename V> struct returnState {
+    const V v;
+    returnState(const V& v) : v(v) {
+    }
+    const svp<S, V> operator()(const S& s) const {
+        return svp<S, V>(s, v);
+    }
+};
+
+template<typename S, typename V> const state<S, V> result(const V& v) {
+    return state<S, V>(returnState<S, V>(v));
+}
+
+/**
+ * Return a state monad with a transformer function.
+ * A transformer function takes a state and returns an svp pair carrying a value and a
+ * new (transformed) state.
+ */
+template<typename S, typename V> const state<S, V> transformer(const lambda<svp<S, V>(S)>& f) {
+    return state<S, V>(f);
+}
+
+/**
+ * Bind a function to a state monad. The function takes a value and returns a state
+ * monad carrying a return value.
+ */
+template<typename S, typename A, typename B> struct stateBind {
+    const state<S, A> st;
+    const lambda<state<S, B>(A)>f;
+
+    stateBind(const state<S, A>& st, const lambda<state<S, B>(A)>& f) : st(st), f(f) {
+    }
+
+    const svp<S, B> operator()(const S& is) const {
+        const svp<S, A> iscp = st(is);
+        const state<S, B> m = f((A)iscp);
+        return m((S)iscp);
+    }
+};
+
+template<typename S, typename A, typename B>
+const state<S, B> operator>>(const state<S, A>& st, const lambda<state<S, B>(A)>& f) {
+    return state<S, B>(stateBind<S, A , B>(st, f));
+}
+
+template<typename S, typename A, typename B>
+const state<S, B> operator>>(const state<S, A>& st, const state<S, B> (* const f)(const A)) {
+    return state<S, B>(stateBind<S, A , B>(st, f));
+}
+
+}
+#endif /* tuscany_monad_hpp */

Modified: tuscany/cpp/sca/kernel/parallel.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/kernel/parallel.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/kernel/parallel.hpp (original)
+++ tuscany/cpp/sca/kernel/parallel.hpp Sun Oct 11 00:01:04 2009
@@ -254,9 +254,9 @@
  * Enqueues shutdown requests.
  */
 const bool shutdownEnqueue(const list<pthread_t>& threads, queue<lambda<bool()> >& work) {
-    if (threads == list<pthread_t>())
+    if (isNil(threads))
         return true;
-    enqueue(work, unit(false));
+    enqueue(work, result(false));
     return shutdownEnqueue(cdr(threads), work);
 }
 
@@ -264,7 +264,7 @@
  * Waits for shut down threads to terminate.
  */
 const bool shutdownJoin(const list<pthread_t>& threads) {
-    if (threads == list<pthread_t>())
+    if (isNil(threads))
         return true;
     pthread_join(car(threads), NULL);
     return shutdownJoin(cdr(threads));

Modified: tuscany/cpp/sca/kernel/value.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/kernel/value.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/kernel/value.hpp (original)
+++ tuscany/cpp/sca/kernel/value.hpp Sun Oct 11 00:01:04 2009
@@ -128,43 +128,43 @@
     }
 
     value(const std::string& str) :
-        type(value::String), data(vdata(unit(str))) {
+        type(value::String), data(vdata(result(str))) {
         countValues++;
         countVValues++;
     }
 
     value(const char* str) :
-        type(value::Symbol), data(vdata(unit(std::string(str)))) {
+        type(value::Symbol), data(vdata(result(std::string(str)))) {
         countValues++;
         countVValues++;
     }
 
     value(const list<value>& lst) :
-        type(value::List), data(vdata(unit(lst))) {
+        type(value::List), data(vdata(result(lst))) {
         countValues++;
         countVValues++;
     }
 
     value(const double num) :
-        type(value::Number), data(vdata(unit(num))) {
+        type(value::Number), data(vdata(result(num))) {
         countValues++;
         countVValues++;
     }
 
     value(const int num) :
-        type(value::Number), data(vdata(unit((double)num))) {
+        type(value::Number), data(vdata(result((double)num))) {
         countValues++;
         countVValues++;
     }
 
     value(const bool boo) :
-        type(value::Boolean), data(vdata(unit(boo))) {
+        type(value::Boolean), data(vdata(result(boo))) {
         countValues++;
         countVValues++;
     }
 
     value(const char chr) :
-        type(value::Character), data(vdata(unit(chr))) {
+        type(value::Character), data(vdata(result(chr))) {
         countValues++;
         countVValues++;
     }

Modified: tuscany/cpp/sca/kernel/xml.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/kernel/xml.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/kernel/xml.hpp (original)
+++ tuscany/cpp/sca/kernel/xml.hpp Sun Oct 11 00:01:04 2009
@@ -32,6 +32,7 @@
 #include <libxml/globals.h>
 #include <string>
 #include "list.hpp"
+#include "monad.hpp"
 
 namespace tuscany {
 
@@ -267,7 +268,7 @@
 /**
  * Write a list of XML element or attribute tokens.
  */
-const bool writeList(const list<value>& l, const xmlTextWriterPtr xml) {
+const failable<bool, std::string> writeList(const list<value>& l, const xmlTextWriterPtr xml) {
     if (isNil(l))
         return true;
 
@@ -275,21 +276,23 @@
     const list<value> token(car(l));
     if (isAttribute(token)) {
         if (xmlTextWriterWriteAttribute(xml, (const xmlChar*)attributeName(token).c_str(), (const xmlChar*)attributeText(token).c_str()) < 0)
-            return false;
+            return std::string("xmlTextWriterWriteAttribute failed");
 
     } else if (isElement(token)) {
 
         // Write an element
         if (xmlTextWriterStartElement(xml, (const xmlChar*)elementName(token).c_str()) < 0)
-            return false;
+            return std::string("xmlTextWriterStartElement failed");
         if (elementHasText(token) && xmlTextWriterWriteString(xml, (const xmlChar*)elementText(token).c_str()) < 0)
-            return false;
+            return std::string("xmlTextWriterWriteString failed");
 
         // Write its children
-        writeList(elementChildren(token), xml);
+        const failable<bool, std::string> w = writeList(elementChildren(token), xml);
+        if (!hasValue(w))
+            return w;
 
         if (xmlTextWriterEndElement(xml) < 0)
-            return false;
+            return std::string("xmlTextWriterEndElement failed");
     }
 
     // Go on
@@ -299,12 +302,16 @@
 /**
  * Write a list of values to a libxml2 XML writer.
  */
-const bool write(const list<value>& l, const xmlTextWriterPtr xml) {
+const failable<bool, std::string> write(const list<value>& l, const xmlTextWriterPtr xml) {
     if (xmlTextWriterStartDocument(xml, NULL, encoding, NULL) < 0)
-        return false;
-    writeList(l, xml);
+        return std::string("xmlTextWriterStartDocument failed");
+
+    const failable<bool, std::string> w = writeList(l, xml);
+    if (!hasValue(w))
+        return w;
+
     if (xmlTextWriterEndDocument(xml) < 0)
-        return false;
+        return std::string("xmlTextWriterEndDocument failed");
     return true;
 }
 
@@ -331,12 +338,17 @@
 /**
  * Write a list of values as an XML document.
  */
-template<typename R> const R writeXML(const lambda<R(R, std::string)>& reduce, const R& initial, const list<value>& l) {
+template<typename R> const failable<R, std::string> writeXML(const lambda<R(R, std::string)>& reduce, const R& initial, const list<value>& l) {
     XMLWriteContext<R> cx(reduce, initial);
     xmlOutputBufferPtr out = xmlOutputBufferCreateIO(writeCallback<R>, NULL, &cx, NULL);
     xmlTextWriterPtr xml = xmlNewTextWriter(out);
-    if (xml != NULL)
-        write(l, xml);
+    if (xml == NULL)
+        return std::string("xmlNewTextWriter failed");
+
+    const failable<bool, std::string> w = write(l, xml);
+    if (!hasValue(w))
+        return std::string(w);
+
     return cx.accum;
 }
 
@@ -347,9 +359,11 @@
 /**
  * Write a list of values as an XML document represented as a list of strings.
  */
-const list<std::string> writeXML(const list<value>& l) {
-    lambda<list<std::string>(list<std::string>, std::string)> writer(writeXMLList);
-    return reverse(writeXML(writer, list<std::string>(), l));
+const failable<list<std::string>, std::string> writeXML(const list<value>& l) {
+    const failable<list<std::string>, std::string> ls = writeXML<list<std::string> >(writeXMLList, list<std::string>(), l);
+    if (!hasValue(ls))
+        return ls;
+    return reverse(list<std::string>(ls));
 }
 
 }

Modified: tuscany/cpp/sca/modules/eval/environment.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/modules/eval/environment.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/modules/eval/environment.hpp (original)
+++ tuscany/cpp/sca/modules/eval/environment.hpp Sun Oct 11 00:01:04 2009
@@ -80,16 +80,16 @@
 }
 
 const Frame makeBinding(const Frame& frameSoFar, const list<value>& variables, const list<value> values) {
-    if (variables == list<value>()) {
-        if (values != list<value>())
+    if (isNil(variables)) {
+        if (!isNil(values))
             std::cout << "Too many arguments supplied " << values << "\n";
         return frameSoFar;
     }
     if (isDotVariable(car(variables)))
         return makeBinding(frameSoFar, cdr(variables), makeList<value>(values));
 
-    if (values == list<value>()) {
-        if (variables != list<value>())
+    if (isNil(values)) {
+        if (!isNil(variables))
             std::cout << "Too few arguments supplied " << variables << "\n";
         return frameSoFar;
     }
@@ -158,7 +158,7 @@
 const value lookupEnvLoop(const value& var, const Env& env);
 
 const value lookupEnvScan(const value& var, const list<value>& vars, const list<value>& vals, const Env& env) {
-    if(vars == list<value> ())
+    if(isNil(vars))
         return lookupEnvLoop(var, enclosingEnvironment(env));
     if(var == car(vars))
         return car(vals);

Modified: tuscany/cpp/sca/modules/eval/eval.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/modules/eval/eval.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/modules/eval/eval.hpp (original)
+++ tuscany/cpp/sca/modules/eval/eval.hpp Sun Oct 11 00:01:04 2009
@@ -87,7 +87,7 @@
 }
 
 const list<value> listOfValues(const list<value> exps, Env& env) {
-    if(exps == list<value> ())
+    if(isNil(exps))
         return list<value> ();
     return cons(eval(car(exps), env), listOfValues(cdr(exps), env));
 }
@@ -117,7 +117,7 @@
 }
 
 const bool isLastExp(const list<value>& seq) {
-    return cdr(seq) == list<value> ();
+    return isNil(cdr(seq));
 }
 
 const value firstExp(const list<value>& seq) {
@@ -151,7 +151,7 @@
 }
 
 const value sequenceToExp(const list<value> exps) {
-    if(exps == list<value> ())
+    if(isNil(exps))
         return list<value>();
     if(isLastExp(exps))
         return firstExp(exps);
@@ -179,7 +179,7 @@
 }
 
 const value ifAlternative(const value& exp) {
-    if(cdr(cdr(cdr((list<value> )exp))) != list<value> ())
+    if(!isNil(cdr(cdr(cdr((list<value> )exp)))))
         return car(cdr(cdr(cdr((list<value> )exp))));
     return false;
 }
@@ -201,12 +201,12 @@
 }
 
 const value expandClauses(const list<value>& clauses) {
-    if(clauses == list<value> ())
+    if(isNil(clauses))
         return false;
     const value first = car(clauses);
     const list<value> rest = cdr(clauses);
     if(isCondElseClause(first)) {
-        if(rest == list<value> ())
+        if(isNil(rest))
             return sequenceToExp(condActions(first));
         std::cout << "else clause isn't last " << clauses << "\n";
         return value();

Modified: tuscany/cpp/sca/modules/eval/primitive.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/modules/eval/primitive.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/modules/eval/primitive.hpp (original)
+++ tuscany/cpp/sca/modules/eval/primitive.hpp Sun Oct 11 00:01:04 2009
@@ -70,13 +70,13 @@
 }
 
 const value valueAdd(list<value>& args) {
-    if (cdr(args) == list<value>())
+    if (isNil(cdr(args)))
         return (double)car(args);
     return (double)car(args) + (double)cadr(args);
 }
 
 const value valueSub(list<value>& args) {
-    if (cdr(args) == list<value>())
+    if (isNil(cdr(args)))
         return (double)0 - (double)car(args);
     return (double)car(args) - (double)cadr(args);
 }
@@ -95,7 +95,7 @@
 }
 
 const value valueComment(list<value>& args) {
-    *evalOut << "# " << car(args);
+    *evalOut << "; " << car(args);
     return true;
 }
 

Modified: tuscany/cpp/sca/modules/eval/read.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/modules/eval/read.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/modules/eval/read.hpp (original)
+++ tuscany/cpp/sca/modules/eval/read.hpp Sun Oct 11 00:01:04 2009
@@ -134,7 +134,7 @@
 }
 
 const std::string listToString(const list<char>& l) {
-    if(l == list<char> ())
+    if(isNil(l))
         return "";
     return car(l) + listToString(cdr(l));
 }

Modified: tuscany/cpp/sca/test/store-function/cart.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/test/store-function/cart.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/test/store-function/cart.hpp (original)
+++ tuscany/cpp/sca/test/store-function/cart.hpp Sun Oct 11 00:01:04 2009
@@ -50,8 +50,7 @@
 }
 
 const double shoppingCart_getTotal() {
-    tuscany::lambda<double(double, ItemType)> a(accumTotal);
-    return reduce(a, 0.0, cart);
+    return tuscany::reduce<ItemType, double>(accumTotal, 0.0, cart);
 }
 
 const tuscany::value shoppingCart_service(const tuscany::list<tuscany::value>& args) {

Modified: tuscany/cpp/sca/test/store-object/cart.hpp
URL: http://svn.apache.org/viewvc/tuscany/cpp/sca/test/store-object/cart.hpp?rev=823981&r1=823980&r2=823981&view=diff
==============================================================================
--- tuscany/cpp/sca/test/store-object/cart.hpp (original)
+++ tuscany/cpp/sca/test/store-object/cart.hpp Sun Oct 11 00:01:04 2009
@@ -66,8 +66,7 @@
     }
 
     virtual const double getTotal() const {
-        tuscany::lambda<double(double, Item)> a(accum);
-        return reduce(a, 0.0, cart);
+        return tuscany::reduce<Item, double>(accum, 0.0, cart);
     }
 };