summaryrefslogtreecommitdiffstats
path: root/sca-cpp/trunk/kernel
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--sca-cpp/trunk/kernel/element.hpp5
-rw-r--r--sca-cpp/trunk/kernel/kernel-test.cpp16
-rw-r--r--sca-cpp/trunk/kernel/list.hpp11
-rw-r--r--sca-cpp/trunk/kernel/tree.hpp30
4 files changed, 51 insertions, 11 deletions
diff --git a/sca-cpp/trunk/kernel/element.hpp b/sca-cpp/trunk/kernel/element.hpp
index 4798570982..5c1d515004 100644
--- a/sca-cpp/trunk/kernel/element.hpp
+++ b/sca-cpp/trunk/kernel/element.hpp
@@ -167,6 +167,8 @@ inline const bool elementToValueIsSymbol(const value& v) {
}
inline const list<value> elementToValueGroupValues(const value& v, const list<value>& l) {
+ debug(v, "elementToValueGroupValues::v");
+ debug(l, "elementToValueGroupValues::l");
if (isNull(l) || !elementToValueIsSymbol(v) || !elementToValueIsSymbol(car(l)))
return cons(v, l);
if (car<value>(car(l)) != car<value>(v))
@@ -175,7 +177,8 @@ inline const list<value> elementToValueGroupValues(const value& v, const list<va
const value g = mklist<value>(car<value>(v), mklist<value>(isList(cadr<value>(v))? (value)cdr<value>(v) : cadr<value>(v), isList(cadr<value>(car(l)))? (value)cdr<value>(car(l)) : cadr<value>(car(l))));
return elementToValueGroupValues(g, cdr(l));
}
- const value g = mklist<value>(car<value>(v), cons<value>(isList(cadr<value>(v))? (value)cdr<value>(v) : cadr<value>(v), (list<value>)cadr<value>(car(l))));
+ const value g = isNull(cdr<value>(v))? mklist<value>(car<value>(v), (list<value>)cadr<value>(car(l))) :
+ mklist<value>(car<value>(v), cons<value>(isList(cadr<value>(v))? (value)cdr<value>(v) : cadr<value>(v), (list<value>)cadr<value>(car(l))));
return elementToValueGroupValues(g, cdr(l));
}
diff --git a/sca-cpp/trunk/kernel/kernel-test.cpp b/sca-cpp/trunk/kernel/kernel-test.cpp
index 5d8b8039b4..a880320ca1 100644
--- a/sca-cpp/trunk/kernel/kernel-test.cpp
+++ b/sca-cpp/trunk/kernel/kernel-test.cpp
@@ -477,6 +477,19 @@ const bool testAppend() {
return true;
}
+const bool testSublist() {
+ assert(listHead(mklist(1, 2), 0) == list<int>());
+ assert(listHead(mklist(1, 2), 1) == mklist(1));
+ assert(listHead(mklist(1, 2), 2) == mklist(1, 2));
+ assert(listHead(mklist(1, 2), 3) == mklist(1, 2));
+
+ assert(listTail(mklist(1, 2), 0) == mklist(1, 2));
+ assert(listTail(mklist(1, 2), 1) == mklist(2));
+ assert(listTail(mklist(1, 2), 2) == list<int>());
+ assert(listTail(mklist(1, 2), 3) == list<int>());
+ return true;
+}
+
class Complex {
public:
Complex() : x(0), y(0) {
@@ -675,7 +688,7 @@ const double testSeqMap(const double x) {
return x;
}
-double testSeqReduce(unused const double v, const double accum) {
+double testSeqReduce(const double accum, unused const double v) {
return accum + 1.0;
}
@@ -956,6 +969,7 @@ int main() {
tuscany::testEquals();
tuscany::testLength();
tuscany::testAppend();
+ tuscany::testSublist();
tuscany::testComplex();
tuscany::testMap();
tuscany::testReduce();
diff --git a/sca-cpp/trunk/kernel/list.hpp b/sca-cpp/trunk/kernel/list.hpp
index 753b33b6a0..e20f3fbd8e 100644
--- a/sca-cpp/trunk/kernel/list.hpp
+++ b/sca-cpp/trunk/kernel/list.hpp
@@ -523,6 +523,17 @@ template<typename T> inline const T listRef(const list<T>& l, const size_t i) no
}
/**
+ * Returns a new list consisting of the first k elements of a list.
+ */
+template<typename T> inline const list<T> listHead(const list<T>& l, const size_t k) noexcept {
+ if(k == 0)
+ return list<T>();
+ if(isNull(l))
+ return l;
+ return cons<T>(car(l), listHead(cdr(l), k - 1));
+}
+
+/**
* Returns the tail of a list, ommiting the first k elements.
*/
template<typename T> inline const list<T> listTail(const list<T>& l, const size_t k) noexcept {
diff --git a/sca-cpp/trunk/kernel/tree.hpp b/sca-cpp/trunk/kernel/tree.hpp
index a5d0e3d5b0..77f2f1ea54 100644
--- a/sca-cpp/trunk/kernel/tree.hpp
+++ b/sca-cpp/trunk/kernel/tree.hpp
@@ -174,25 +174,37 @@ template<typename T> inline const list<T> rbtreeAssoc(const T& k, const list<T>&
}
/**
+ * Default function used to compare two values while building a rooted binary tree.
+ */
+template<typename T> inline const int rbtreeComp(const T& a, const T& b) {
+ if (a == b)
+ return 0;
+ if (a < b)
+ return -1;
+ return 1;
+}
+
+/**
* Construct a new rooted binary tree from a leaf and a tree.
*/
-template<typename T> inline const list<T> rbtreeCons(const T& e, const list<T>& tree) {
+template<typename T> inline const list<T> rbtreeCons(const T& e, const list<T>& tree, const lambda<int(const T&, const T&)>& comp = rbtreeComp<T>) {
if (isNull(tree))
return mkrbtree(e, list<T>(), list<T>());
- if (e == car(tree))
+ const int c = comp(e, car(tree));
+ if (c == 0)
return tree;
- if (e < car(tree))
- return mkrbtree<T>(car(tree), rbtreeCons<T>(e, cadr(tree)), caddr(tree));
- return mkrbtree<T>(car(tree), cadr(tree), rbtreeCons<T>(e, caddr(tree)));
+ if (c == -1)
+ return mkrbtree<T>(car(tree), rbtreeCons<T>(e, cadr(tree), comp), caddr(tree));
+ return mkrbtree<T>(car(tree), cadr(tree), rbtreeCons<T>(e, caddr(tree), comp));
}
/**
* Make a rooted binary tree from an unordered list of leaves.
*/
-template<typename T> inline const list<T> mkrbtree(const list<T>& l) {
+template<typename T> inline const list<T> mkrbtree(const list<T>& l, const lambda<int(const T&, const T&)>& comp = rbtreeComp<T>) {
if (isNull(l))
return l;
- return rbtreeCons(car(l), mkrbtree(cdr(l)));
+ return rbtreeCons(car(l), mkrbtree(cdr(l), comp), comp);
}
/**
@@ -207,8 +219,8 @@ template<typename T> inline const list<T> flatten(const list<T>& tree) {
/**
* Sort a list, using a rooted binary tree.
*/
-template<typename T> inline const list<T> sort(const list<T>& l) {
- return flatten(mkrbtree(l));
+template<typename T> inline const list<T> sort(const list<T>& l, const lambda<int(const T&, const T&)>& comp = rbtreeComp<T>) {
+ return flatten(mkrbtree(l, comp));
}
/**