summaryrefslogtreecommitdiffstats
path: root/cpp/sca/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'cpp/sca/kernel')
-rw-r--r--cpp/sca/kernel/element.hpp143
-rw-r--r--cpp/sca/kernel/function.hpp4
-rw-r--r--cpp/sca/kernel/kernel-test.cpp75
-rw-r--r--cpp/sca/kernel/list.hpp71
-rw-r--r--cpp/sca/kernel/value.hpp41
-rw-r--r--cpp/sca/kernel/xml.hpp55
6 files changed, 282 insertions, 107 deletions
diff --git a/cpp/sca/kernel/element.hpp b/cpp/sca/kernel/element.hpp
index 9b0f1f5f0a..af221f849b 100644
--- a/cpp/sca/kernel/element.hpp
+++ b/cpp/sca/kernel/element.hpp
@@ -60,6 +60,13 @@ const value elementName(const list<value>& l) {
}
/**
+ * Returns true if an element has children.
+ */
+const bool elementHasChildren(const list<value>& l) {
+ return !isNil(cddr(l));
+}
+
+/**
* Returns the children of an element.
*/
const list<value> elementChildren(const list<value>& l) {
@@ -70,15 +77,11 @@ const list<value> elementChildren(const list<value>& l) {
* Returns true if an element has a value.
*/
const value elementHasValue(const list<value>& l) {
- if (isNil(cddr(l)))
- return false;
const list<value> r = reverse(l);
- if(isList(car(r))) {
- const list<value> v = car(r);
- if(isSymbol(car(v))) {
+ if (isSymbol(car(r)))
+ return false;
+ if(isList(car(r)) && isSymbol(car<value>(car(r))))
return false;
- }
- }
return true;
}
@@ -90,36 +93,122 @@ const value elementValue(const list<value>& l) {
}
/**
- * Converts a list of elements to a list of values.
+ * Convert an element to a value.
*/
-const list<value> elementsToValues(const list<value>& e) {
- if (isNil(e))
- return list<value>();
- const value t = car(e);
+const bool elementToValueIsList(const value& v) {
+ if (!isList(v))
+ return false;
+ const list<value> l = v;
+ if(isNil(l))
+ return true;
+ return isList(car(l));
+}
+
+const value elementToValue(const value& t) {
+ const list<value> elementsToValues(const list<value>& e);
+
+ // Convert an attribute
if (isTaggedList(t, attribute))
- return cons<value>(mklist(attributeName(t), attributeValue(t)), elementsToValues(cdr(e)));
+ return mklist(attributeName(t), attributeValue(t));
+
+ // Convert an element
if (isTaggedList(t, element)) {
- if (elementHasValue(t))
- return cons<value>(mklist(elementName(t), elementValue(t)), elementsToValues(cdr(e)));
- return cons<value>(cons(elementName(t), elementsToValues(elementChildren(t))), elementsToValues(cdr(e)));
+
+ // Convert an element's value
+ if (elementHasValue(t)) {
+
+ // Convert a single value
+ if (!elementToValueIsList(elementValue(t)))
+ return mklist(elementName(t), elementValue(t));
+
+ // Convert a list value
+ return cons(elementName(t), mklist<value>(elementsToValues(elementValue(t))));
+ }
+
+ // Convert an element's children
+ return cons(elementName(t), elementsToValues(elementChildren(t)));
}
- return cons(t, elementsToValues(cdr(e)));
+
+ // Convert a value
+ if (!isList(t))
+ return t;
+ return elementsToValues(t);
}
/**
- * Converts a list of values to a list of elements.
+ * Convert a list of elements to a list of values.
*/
-const list<value> valuesToElements(const list<value>& e) {
+const bool elementToValueIsSymbol(const value& v) {
+ if (!isList(v))
+ return false;
+ const list<value> l = v;
+ if (isNil(l))
+ return false;
+ if (!isSymbol(car(l)))
+ return false;
+ return true;
+}
+
+const list<value> elementToValueGroupValues(const value& v, const list<value>& l) {
+ if (isNil(l) || !elementToValueIsSymbol(v) || !elementToValueIsSymbol(car(l))) {
+ return cons(v, l);
+ }
+ if (car<value>(car(l)) != car<value>(v)) {
+ return cons(v, l);
+ }
+ if (!elementToValueIsList(cadr<value>(car(l)))) {
+ const value g = mklist<value>(car<value>(v), mklist<value>(cdr<value>(v), cdr<value>(car(l))));
+ return elementToValueGroupValues(g, cdr(l));
+ }
+ const value g = mklist<value>(car<value>(v), cons<value>(cdr<value>(v), (list<value>)cadr<value>(car(l))));
+ return elementToValueGroupValues(g, cdr(l));
+
+}
+
+const list<value> elementsToValues(const list<value>& e) {
if (isNil(e))
return list<value>();
- const value t = car(e);
- if (isList(t)) {
+ const value v = elementToValue(car(e));
+ const list<value> n = elementsToValues(cdr(e));
+ return elementToValueGroupValues(elementToValue(car(e)), elementsToValues(cdr(e)));
+}
+
+/**
+ * Convert a value to an element.
+ */
+const value valueToElement(const value& t) {
+ const list<value> valuesToElements(const list<value>& l);
+
+ // Convert a name value pair
+ if (isList(t) && isSymbol(car<value>(t))) {
+ const value n = car<value>(t);
const value v = cadr<value>(t);
+
+ // Convert a single value
if (!isList(v))
- return cons<value>(mklist(attribute, car<value>(t), v), valuesToElements(cdr(e)));
- return cons<value>(cons(element, cons(car<value>(t), valuesToElements(cdr<value>(t)))), valuesToElements(cdr(e)));
+ return mklist(element, n, v);
+
+ // Convert a list value
+ if (!isSymbol(car<value>(v)))
+ return cons(element, cons(n, mklist<value>(valuesToElements(v))));
+
+ // Convert a nested name value pair value
+ return cons(element, cons(n, valuesToElements(cdr<value>(t))));
}
- return cons(t, valuesToElements(cdr(e)));
+
+ // Convert a value
+ if (!isList(t))
+ return t;
+ return valuesToElements(t);
+}
+
+/**
+ * Convert a list of values to a list of elements.
+ */
+const list<value> valuesToElements(const list<value>& l) {
+ if (isNil(l))
+ return list<value>();
+ return cons<value>(valueToElement(car(l)), valuesToElements(cdr(l)));
}
/**
@@ -130,19 +219,19 @@ struct selectorLambda {
const list<value> select;
selectorLambda(const list<value>& s) : select(s) {
}
- const bool eval(const list<value>& s, const list<value> v) const {
+ const bool evalApply(const list<value>& s, const list<value> v) const {
if (isNil(s))
return true;
if (isNil(v))
return false;
if (car(s) != car(v))
return false;
- return eval(cdr(s), cdr(v));
+ return evalApply(cdr(s), cdr(v));
}
const bool operator()(const value& v) const {
if (!isList(v))
return false;
- return eval(select, v);
+ return evalApply(select, v);
}
};
diff --git a/cpp/sca/kernel/function.hpp b/cpp/sca/kernel/function.hpp
index 55637f68bf..9492879e5e 100644
--- a/cpp/sca/kernel/function.hpp
+++ b/cpp/sca/kernel/function.hpp
@@ -139,7 +139,7 @@ public:
const lambda& operator=(const lambda& l) {
if (this == &l)
- return *this;
+ return *this;
callable = l.callable;
return *this;
}
@@ -150,7 +150,7 @@ public:
const bool operator==(const lambda& l) const {
if (this == &l)
- return true;
+ return true;
return callable == l.callable;
}
diff --git a/cpp/sca/kernel/kernel-test.cpp b/cpp/sca/kernel/kernel-test.cpp
index 2d4158ea11..9f977a64f9 100644
--- a/cpp/sca/kernel/kernel-test.cpp
+++ b/cpp/sca/kernel/kernel-test.cpp
@@ -34,6 +34,7 @@
#include "slist.hpp"
#include "parallel.hpp"
#include "value.hpp"
+#include "element.hpp"
#include "xml.hpp"
#include "monad.hpp"
@@ -67,6 +68,12 @@ bool testLambda() {
assert(incf(1) == 11);
assert(mapLambda(incf, 1) == 11);
assert(mapLambda(inc(10), 1) == 11);
+
+ lambda<int(int)> l;
+ l = incf;
+ assert(l(1) == 11);
+ l = square;
+ assert(l(2) == 4);
return true;
}
@@ -115,11 +122,23 @@ bool testCons() {
return true;
}
+bool testSet() {
+ list<int> l = mklist(1, 2, 3);
+ setCar(l, 4);
+ setCdr(l, mklist(5, 6));
+ assert(car(l) == 4);
+ assert(cadr(l) == 5);
+ assert(caddr(l) == 6);
+ assert(isNil(cdddr(l)));
+ return true;
+}
+
bool testListGC() {
resetLambdaCounters();
resetListCounters();
countElements = 0;
testCons();
+ testSet();
assert(countLambdas == 0);
assert(countlists == 0);
assert(countElements == 0);
@@ -133,7 +152,7 @@ bool testOut() {
std::ostringstream os2;
os2 << mklist(1, 2, 3);
- assert(os2.str() == "(1, (2, (3, ())))");
+ assert(os2.str() == "(1, 2, 3)");
return true;
}
@@ -329,18 +348,6 @@ bool testValueGC() {
return true;
}
-bool testElement() {
- const list<value> ad = mklist<value>(mklist<value>(attribute, "city", std::string("san francisco")), mklist<value>(attribute, "state", std::string("ca")));
- const list<value> ac = mklist<value>(mklist<value>(attribute, "id", std::string("1234")), mklist<value>(attribute, "balance", 1000));
- const list<value> cr = mklist<value>(mklist<value> (attribute, "name", std::string("jdoe")), cons<value>(element, cons<value>("address", ad)), cons<value>(element, cons<value>("account", ac)));
- const list<value> c = mklist<value>(cons<value>(element, cons<value>("customer", cr)));
-
- const list<value> v = elementsToValues(c);
- const list<value> e = valuesToElements(v);
- assert(e == c);
- return true;
-}
-
double fib_aux(double n, double a, double b) {
if(n == 0.0)
return a;
@@ -487,9 +494,12 @@ const std::string customerXML =
"<name>jdoe</name>"
"<address><city>san francisco</city><state>ca</state></address>"
"<account><id>1234</id><balance>1000</balance></account>"
+"<account><id>6789</id><balance>2000</balance></account>"
+"<account><id>4567</id><balance>3000</balance></account>"
"</customer>"
"\n";
+
const bool isName(const value& token) {
return isTaggedList(token, attribute) && attributeName(token) == "name";
}
@@ -534,6 +544,44 @@ bool testWriteXML() {
return true;
}
+bool testElement() {
+ {
+ const list<value> ad = mklist<value>(mklist<value>("city", std::string("san francisco")), mklist<value>("state", std::string("ca")));
+ const list<value> ac1 = mklist<value>(mklist<value>("id", std::string("1234")), mklist<value>("balance", 1000));
+ const list<value> ac2 = mklist<value>(mklist<value>("id", std::string("6789")), mklist<value>("balance", 2000));
+ const list<value> ac3 = mklist<value>(mklist<value>("id", std::string("4567")), mklist<value>("balance", 3000));
+ {
+ const list<value> c = mklist<value>(mklist<value>("customer", mklist<value>("name", std::string("jdoe")), cons<value>("address", ad), mklist<value>("account", mklist<value>(ac1, ac2, ac3))));
+ const list<value> e = valuesToElements(c);
+ const list<value> v = elementsToValues(e);
+ assert(v == c);
+
+ std::ostringstream os;
+ writeXML<std::ostringstream*>(xmlWriter, &os, e);
+ assert(os.str() == customerXML);
+ }
+ {
+ const list<value> c = mklist<value>(mklist<value>("customer", mklist<value>("name", std::string("jdoe")), cons<value>("address", ad), cons<value>("account", ac1), cons<value>("account", ac2), cons<value>("account", ac3)));
+ const list<value> e = valuesToElements(c);
+ const list<value> v = elementsToValues(e);
+
+ std::ostringstream os;
+ writeXML<std::ostringstream*>(xmlWriter, &os, e);
+ assert(os.str() == customerXML);
+ }
+ }
+ {
+ std::istringstream is(customerXML);
+ const list<value> c = readXML(streamList(is));
+ const list<value> v = elementsToValues(c);
+ const list<value> e = valuesToElements(v);
+ std::ostringstream os;
+ writeXML<std::ostringstream*>(xmlWriter, &os, e);
+ assert(os.str() == customerXML);
+ }
+ return true;
+}
+
const id<int> idF(const int v) {
return v * 2;
}
@@ -644,6 +692,7 @@ int main() {
tuscany::testLambda();
tuscany::testLambdaGC();
tuscany::testCons();
+ tuscany::testSet();
tuscany::testListGC();
tuscany::testOut();
tuscany::testEquals();
diff --git a/cpp/sca/kernel/list.hpp b/cpp/sca/kernel/list.hpp
index 8c5ab30d1d..62c5d91150 100644
--- a/cpp/sca/kernel/list.hpp
+++ b/cpp/sca/kernel/list.hpp
@@ -114,7 +114,10 @@ public:
template<typename X> friend const bool isNil(const list<X>& p);
template<typename X> friend const X car(const list<X>& p);
- template<typename X> friend list<X> const cdr(const list<X>& p);
+ template<typename X> friend const list<X> cdr(const list<X>& p);
+ template<typename X> friend const bool setCar(list<X>& p, const X& car);
+ template<typename X> friend const bool setCdr(list<X>& p, const list<X>& cdr);
+ template<typename X> friend const bool setCdr(list<X>& p, const lambda<list<X> ()>& cdr);
private:
T car;
@@ -131,10 +134,19 @@ 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) {
+template<typename T> std::ostream& operator<<(std::ostream& out, const list<T>& l) {
if(isNil(l))
return out << "()";
- return out << "(" << car(l) << ", " << cdr(l) << ")";
+ out << "(";
+ list<T> ml = l;
+ while(true) {
+ out << car(ml);
+ ml = cdr(ml);
+ if (isNil(ml))
+ break;
+ out << ", ";
+ }
+ return out << ")";
}
/**
@@ -194,6 +206,13 @@ template<typename T> const list<T> mklist(const T& a, const T& b, const T& c, co
}
/**
+ * Construct a list of six values.
+ */
+template<typename T> const list<T> mklist(const T& a, const T& b, const T& c, const T& d, const T& e, const T& f) {
+ return cons(a, cons(b, cons(c, cons(d, cons(e, mklist(f))))));
+}
+
+/**
* Returns the car of a list.
*/
template<typename T> const T car(const list<T>& p) {
@@ -203,11 +222,36 @@ template<typename T> const T car(const list<T>& p) {
/**
* Returns the cdr of a list.
*/
-template<typename T> list<T> const cdr(const list<T>& p) {
+template<typename T> const list<T> cdr(const list<T>& p) {
return p.cdr();
}
/**
+ * Sets the car of a list.
+ */
+template<typename T> const bool setCar(list<T>& p, const T& car) {
+ p.car = car;
+ return true;
+}
+
+/**
+ * Sets the cdr of a list.
+ */
+template<typename T> const bool setCdr(list<T>& p, const list<T>& c) {
+ p.cdr = result(c);
+ return true;
+}
+
+/**
+ * Sets the cdr of a list to a lambda function.
+ */
+template<typename T> const bool setCdr(list<T>& p, const lambda<list<T> ()>& cdr) {
+ p.cdr = cdr;
+ return true;
+}
+
+
+/**
* Returns the car of the cdr of a list.
*/
template<typename T> const T cadr(const list<T>& p) {
@@ -415,25 +459,6 @@ template<typename T> const list<list<T> > unzip(const list<list<T> >& l) {
return mklist<list<T> >(unzipKeys(l), unzipValues(l));
}
-/**
- * Pretty print a list.
- */
-template<typename T> std::ostream& print(const list<T>& l, std::ostream& os) {
- os << "(";
- if (!isNil(l)) {
- list<T> ml = l;
- while(true) {
- os << car(ml);
- ml = cdr(ml);
- if (isNil(ml))
- break;
- os << ", ";
- }
- }
- os << ")";
- return os;
-}
-
}
#endif /* tuscany_list_hpp */
diff --git a/cpp/sca/kernel/value.hpp b/cpp/sca/kernel/value.hpp
index a8140d4892..d57264ff43 100644
--- a/cpp/sca/kernel/value.hpp
+++ b/cpp/sca/kernel/value.hpp
@@ -324,24 +324,24 @@ private:
std::ostream& operator<<(std::ostream& out, const value& v) {
switch(v.type) {
case value::List:
- return out << "List::" << v.lst()();
+ return out << v.lst()();
case value::Lambda:
- return out << "Lambda::" << v.func();
+ return out << "lambda::" << v.func();
case value::Symbol:
- return out << "Symbol::" << v.str()();
+ return out << "symbol::" << v.str()();
case value::String:
- return out << "String::" << '\"' << v.str()() << '\"';
+ return out << "string::" << '\"' << v.str()() << '\"';
case value::Number:
- return out << "Number::" << v.num()();
+ return out << "number::" << v.num()();
case value::Boolean:
if(v.boo()())
- return out << "Boolean::" << "true";
+ return out << "bool::" << "true";
else
- return out << "Boolean::" << "false";
+ return out << "bool::" << "false";
case value::Character:
- return out << "Character::" << v.chr()();
+ return out << "char::" << v.chr()();
default:
- return out << "Undefined";
+ return out << "undefined";
}
}
@@ -383,28 +383,5 @@ const bool isTaggedList(const value& exp, value tag) {
return false;
}
-/**
- * Pretty print a list of values.
- */
-std::ostream& print(const list<value>& l, std::ostream& os) {
- os << "(";
- if (!isNil(l)) {
- list<value> ml = l;
- while(true) {
- const value v = car(ml);
- if (isList(v))
- print(list<value>(v), os);
- else
- os << v;
- ml = cdr(ml);
- if (isNil(ml))
- break;
- os << ", ";
- }
- }
- os << ")";
- return os;
-}
-
}
#endif /* tuscany_value_hpp */
diff --git a/cpp/sca/kernel/xml.hpp b/cpp/sca/kernel/xml.hpp
index 16fddef1ef..afc3f5cc38 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 "slist.hpp"
#include "value.hpp"
#include "element.hpp"
#include "monad.hpp"
@@ -47,7 +48,7 @@ public:
None = 0, Element = 1, Attribute = 2, Text = 3, EndElement = 15, Identifier = 100, End = 101
};
- XMLReader(xmlTextReaderPtr xml) : xml(xml), tokenType(None) {
+ XMLReader(xmlTextReaderPtr xml) : xml(xml), tokenType(None), isEmptyElement(false), hasValue(false), hasAttributes(false) {
xmlTextReaderSetParserProp(xml, XML_PARSER_DEFAULTATTRS, 1);
xmlTextReaderSetParserProp(xml, XML_PARSER_SUBST_ENTITIES, 1);
}
@@ -204,9 +205,16 @@ const list<value> readXML(const list<std::string>& ilist) {
*/
const char* encoding = "UTF-8";
+
/**
* Write a list of XML element or attribute tokens.
*/
+const list<value> expandElementValues(const value& n, const list<value>& l) {
+ if (isNil(l))
+ return list<value>();
+ return cons<value>(value(cons<value>(element, cons<value>(n, (list<value>)car(l)))), expandElementValues(n, cdr(l)));
+}
+
const failable<bool, std::string> writeList(const list<value>& l, const xmlTextWriterPtr xml) {
if (isNil(l))
return true;
@@ -219,23 +227,50 @@ const failable<bool, std::string> writeList(const list<value>& l, const xmlTextW
} else if (isTaggedList(token, element)) {
- // Write an element
- if (xmlTextWriterStartElement(xml, (const xmlChar*)std::string(elementName(token)).c_str()) < 0)
- return std::string("xmlTextWriterStartElement failed");
+ // Write an element containing a value
+ if (elementHasValue(token)) {
+ const value v = elementValue(token);
+ if (isList(v)) {
+
+ // Write an element per entry in a list of values
+ const list<value> e = expandElementValues(elementName(token), v);
+ writeList(e, xml);
+
+ } else {
- // Write its children
- const failable<bool, std::string> w = writeList(elementChildren(token), xml);
- if (!hasValue(w))
- return w;
+ // Write an element with a single value
+ if (xmlTextWriterStartElement(xml, (const xmlChar*)std::string(elementName(token)).c_str()) < 0)
+ return std::string("xmlTextWriterStartElement failed");
- if (xmlTextWriterEndElement(xml) < 0)
- return std::string("xmlTextWriterEndElement failed");
+ // Write its children
+ const failable<bool, std::string> w = writeList(elementChildren(token), xml);
+ if (!hasValue(w))
+ return w;
+ if (xmlTextWriterEndElement(xml) < 0)
+ return std::string("xmlTextWriterEndElement failed");
+ }
+ }
+ else {
+
+ // Write an element
+ if (xmlTextWriterStartElement(xml, (const xmlChar*)std::string(elementName(token)).c_str()) < 0)
+ return std::string("xmlTextWriterStartElement failed");
+
+ // Write its children
+ const failable<bool, std::string> w = writeList(elementChildren(token), xml);
+ if (!hasValue(w))
+ return w;
+
+ if (xmlTextWriterEndElement(xml) < 0)
+ return std::string("xmlTextWriterEndElement failed");
+ }
} else {
// Write XML text
if (xmlTextWriterWriteString(xml, (const xmlChar*)std::string(token).c_str()) < 0)
return std::string("xmlTextWriterWriteString failed");
+
}
// Go on
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 18:34:57 +0000