summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--cpp/sca/kernel/function.hpp17
-rw-r--r--cpp/sca/kernel/kernel-test.cpp166
-rw-r--r--cpp/sca/kernel/list.hpp44
-rw-r--r--cpp/sca/kernel/monad.hpp386
-rw-r--r--cpp/sca/kernel/parallel.hpp6
-rw-r--r--cpp/sca/kernel/value.hpp14
-rw-r--r--cpp/sca/kernel/xml.hpp46
-rw-r--r--cpp/sca/modules/eval/environment.hpp10
-rw-r--r--cpp/sca/modules/eval/eval.hpp12
-rw-r--r--cpp/sca/modules/eval/primitive.hpp6
-rw-r--r--cpp/sca/modules/eval/read.hpp2
-rw-r--r--cpp/sca/test/store-function/cart.hpp3
-rw-r--r--cpp/sca/test/store-object/cart.hpp3
13 files changed, 633 insertions, 82 deletions
diff --git a/cpp/sca/kernel/function.hpp b/cpp/sca/kernel/function.hpp
index 07b4111239..c22a93c715 100644
--- a/cpp/sca/kernel/function.hpp
+++ b/cpp/sca/kernel/function.hpp
@@ -174,13 +174,6 @@ template<typename S> std::ostream& operator<<(std::ostream& out, const lambda<S>
}
/**
- * 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 @@ private:
};
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 @@ template<typename R, typename T, typename U, typename V, typename... P> const la
/**
* 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 @@ private:
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);
}
}
diff --git a/cpp/sca/kernel/kernel-test.cpp b/cpp/sca/kernel/kernel-test.cpp
index 576775b75e..22de64cab2 100644
--- a/cpp/sca/kernel/kernel-test.cpp
+++ b/cpp/sca/kernel/kernel-test.cpp
@@ -35,6 +35,7 @@
#include "parallel.hpp"
#include "value.hpp"
#include "xml.hpp"
+#include "monad.hpp"
namespace tuscany {
@@ -52,18 +53,26 @@ const int square(const int x) {
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 testComplex() {
}
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 isPositive(int x) {
}
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 @@ bool testReverse() {
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 @@ bool testSeq() {
//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 @@ bool testCppPerf() {
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 @@ bool testReadXML() {
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 @@ bool testWriteXML() {
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 @@ int main() {
tuscany::testFilter();
tuscany::testMember();
tuscany::testReverse();
+ tuscany::testAssoc();
+ tuscany::testZip();
tuscany::testTokenize();
tuscany::testSeq();
tuscany::testValue();
@@ -485,6 +613,10 @@ int main() {
tuscany::testWorker();
tuscany::testReadXML();
tuscany::testWriteXML();
+ tuscany::testIdMonad();
+ tuscany::testMaybeMonad();
+ tuscany::testFailableMonad();
+ tuscany::testStateMonad();
std::cout << "OK" << std::endl;
diff --git a/cpp/sca/kernel/list.hpp b/cpp/sca/kernel/list.hpp
index 4047e91c1b..189eace9b2 100644
--- a/cpp/sca/kernel/list.hpp
+++ b/cpp/sca/kernel/list.hpp
@@ -123,7 +123,7 @@ template<typename T> const bool isNil(const list<T>& p) {
* 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 @@ template<typename T> const list<T> cons(const T& car, const lambda<list<T> ()>&
* 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 @@ template<typename T> const list<T> append(const list<T>&a, const lambda<list<T>
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 @@ template<typename T> const list<T> seq(const T& start, const T& end) {
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 @@ template<typename T> const list<T> assoc(const T& k, const list<list<T> >& p) {
}
/**
+ * 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) {
diff --git a/cpp/sca/kernel/monad.hpp b/cpp/sca/kernel/monad.hpp
new file mode 100644
index 0000000000..c0e9ca899b
--- /dev/null
+++ b/cpp/sca/kernel/monad.hpp
@@ -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 */
diff --git a/cpp/sca/kernel/parallel.hpp b/cpp/sca/kernel/parallel.hpp
index 82983d9edc..07d1471152 100644
--- a/cpp/sca/kernel/parallel.hpp
+++ b/cpp/sca/kernel/parallel.hpp
@@ -254,9 +254,9 @@ template<typename R> const future<R> submit(worker& w, const lambda<R()>& func)
* 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 @@ const bool shutdownEnqueue(const list<pthread_t>& threads, queue<lambda<bool()>
* 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));
diff --git a/cpp/sca/kernel/value.hpp b/cpp/sca/kernel/value.hpp
index cf356b8a24..ae4c69aab9 100644
--- a/cpp/sca/kernel/value.hpp
+++ b/cpp/sca/kernel/value.hpp
@@ -128,43 +128,43 @@ public:
}
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++;
}
diff --git a/cpp/sca/kernel/xml.hpp b/cpp/sca/kernel/xml.hpp
index cfae5678b8..135587a86f 100644
--- a/cpp/sca/kernel/xml.hpp
+++ b/cpp/sca/kernel/xml.hpp
@@ -32,6 +32,7 @@
#include <libxml/globals.h>
#include <string>
#include "list.hpp"
+#include "monad.hpp"
namespace tuscany {
@@ -267,7 +268,7 @@ const char* encoding = "UTF-8";
/**
* 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 bool writeList(const list<value>& l, const xmlTextWriterPtr xml) {
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 @@ const bool writeList(const list<value>& l, const xmlTextWriterPtr xml) {
/**
* 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 @@ template<typename R> int writeCallback(void *context, const char* buffer, int le
/**
* 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 @@ const list<std::string> writeXMLList(const list<std::string>& listSoFar, const s
/**
* 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));
}
}
diff --git a/cpp/sca/modules/eval/environment.hpp b/cpp/sca/modules/eval/environment.hpp
index 4abf558cfa..671175b96d 100644
--- a/cpp/sca/modules/eval/environment.hpp
+++ b/cpp/sca/modules/eval/environment.hpp
@@ -80,16 +80,16 @@ const bool isDotVariable(const value& var) {
}
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 Env setupEnvironment() {
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);
diff --git a/cpp/sca/modules/eval/eval.hpp b/cpp/sca/modules/eval/eval.hpp
index 783f5c6447..0f6ef77904 100644
--- a/cpp/sca/modules/eval/eval.hpp
+++ b/cpp/sca/modules/eval/eval.hpp
@@ -87,7 +87,7 @@ const list<value> operands(const value& exp) {
}
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 Env procedureEnvironment(const value& exp) {
}
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 applyProcedure(const value& procedure, list<value>& arguments) {
}
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 ifConsequent(const value& exp) {
}
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 makeIf(value predicate, value consequent, value alternative) {
}
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();
diff --git a/cpp/sca/modules/eval/primitive.hpp b/cpp/sca/modules/eval/primitive.hpp
index c31f276e2f..ece89e077d 100644
--- a/cpp/sca/modules/eval/primitive.hpp
+++ b/cpp/sca/modules/eval/primitive.hpp
@@ -70,13 +70,13 @@ const value valueEqual(list<value>& args) {
}
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 valueDisplay(list<value>& args) {
}
const value valueComment(list<value>& args) {
- *evalOut << "# " << car(args);
+ *evalOut << "; " << car(args);
return true;
}
diff --git a/cpp/sca/modules/eval/read.hpp b/cpp/sca/modules/eval/read.hpp
index a6e581c416..9266498d99 100644
--- a/cpp/sca/modules/eval/read.hpp
+++ b/cpp/sca/modules/eval/read.hpp
@@ -134,7 +134,7 @@ const list<value> readList(const list<value>& listSoFar, std::istream& in) {
}
const std::string listToString(const list<char>& l) {
- if(l == list<char> ())
+ if(isNil(l))
return "";
return car(l) + listToString(cdr(l));
}
diff --git a/cpp/sca/test/store-function/cart.hpp b/cpp/sca/test/store-function/cart.hpp
index f3b0f6195e..9ed6474985 100644
--- a/cpp/sca/test/store-function/cart.hpp
+++ b/cpp/sca/test/store-function/cart.hpp
@@ -50,8 +50,7 @@ const bool shoppingCart_deleteAll() {
}
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) {
diff --git a/cpp/sca/test/store-object/cart.hpp b/cpp/sca/test/store-object/cart.hpp
index fc6155aa25..f35a5c4527 100644
--- a/cpp/sca/test/store-object/cart.hpp
+++ b/cpp/sca/test/store-object/cart.hpp
@@ -66,8 +66,7 @@ public:
}
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);
}
};
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-07 11:53:59 +0000