summaryrefslogtreecommitdiffstats
path: root/cpp/sca/kernel
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--cpp/sca/kernel/element.hpp85
-rw-r--r--cpp/sca/kernel/kernel-test.cpp3
-rw-r--r--cpp/sca/kernel/list.hpp9
-rw-r--r--cpp/sca/kernel/monad.hpp81
-rw-r--r--cpp/sca/kernel/value.hpp44
-rw-r--r--cpp/sca/kernel/xml.hpp26
6 files changed, 205 insertions, 43 deletions
diff --git a/cpp/sca/kernel/element.hpp b/cpp/sca/kernel/element.hpp
index d93e90742b..2b5336ba5c 100644
--- a/cpp/sca/kernel/element.hpp
+++ b/cpp/sca/kernel/element.hpp
@@ -39,6 +39,24 @@ const value attribute("attribute");
const value element("element");
/**
+ * Returns true if a value is an element.
+ */
+bool isElement(const value& v) {
+ if (!isList(v) || isNil(v) || element != car<value>(v))
+ return false;
+ return true;
+}
+
+/**
+ * Returns true if a value is an attribute.
+ */
+bool isAttribute(const value& v) {
+ if (!isList(v) || isNil(v) || attribute != car<value>(v))
+ return false;
+ return true;
+}
+
+/**
* Returns the name of an attribute.
*/
const value attributeName(const list<value>& l) {
@@ -99,9 +117,7 @@ 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));
+ return (isNil(l) || !isSymbol(car(l)));
}
const value elementToValue(const value& t) {
@@ -150,12 +166,10 @@ const bool elementToValueIsSymbol(const value& v) {
}
const list<value> elementToValueGroupValues(const value& v, const list<value>& l) {
- if (isNil(l) || !elementToValueIsSymbol(v) || !elementToValueIsSymbol(car(l))) {
+ if (isNil(l) || !elementToValueIsSymbol(v) || !elementToValueIsSymbol(car(l)))
return cons(v, l);
- }
- if (car<value>(car(l)) != car<value>(v)) {
+ 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));
@@ -167,9 +181,7 @@ const list<value> elementToValueGroupValues(const value& v, const list<value>& l
const list<value> elementsToValues(const list<value>& e) {
if (isNil(e))
- return list<value>();
- const value v = elementToValue(car(e));
- const list<value> n = elementsToValues(cdr(e));
+ return e;
return elementToValueGroupValues(elementToValue(car(e)), elementsToValues(cdr(e)));
}
@@ -207,7 +219,7 @@ const value valueToElement(const value& t) {
*/
const list<value> valuesToElements(const list<value>& l) {
if (isNil(l))
- return list<value>();
+ return l;
return cons<value>(valueToElement(car(l)), valuesToElements(cdr(l)));
}
@@ -219,19 +231,19 @@ struct selectorLambda {
const list<value> select;
selectorLambda(const list<value>& s) : select(s) {
}
- const bool evalExpr(const list<value>& s, const list<value> v) const {
+ const bool evalSelect(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 evalExpr(cdr(s), cdr(v));
+ return evalSelect(cdr(s), cdr(v));
}
const bool operator()(const value& v) const {
if (!isList(v))
return false;
- return evalExpr(select, v);
+ return evalSelect(select, v);
}
};
@@ -239,5 +251,50 @@ const lambda<bool(value)> selector(const list<value> s) {
return selectorLambda(s);
}
+/**
+ * Returns the value of the attribute with the given name.
+ */
+struct filterAttribute {
+ const value name;
+ filterAttribute(const value& n) : name(n) {
+ }
+ const bool operator()(const value& v) const {
+ return isAttribute(v) && attributeName((list<value>)v) == name;
+ }
+};
+
+const value attributeValue(const value& name, const value& l) {
+ const list<value> f = filter<value>(filterAttribute(name), list<value>(l));
+ if (isNil(f))
+ return value();
+ return caddr<value>(car(f));
+}
+
+/**
+ * Returns child elements with the given name.
+ */
+struct filterElement {
+ const value name;
+ filterElement(const value& n) : name(n) {
+ }
+ const bool operator()(const value& v) const {
+ return isElement(v) && elementName((list<value>)v) == name;
+ }
+};
+
+const value elementChildren(const value& name, const value& l) {
+ return filter<value>(filterElement(name), list<value>(l));
+}
+
+/**
+ * Return the child element with the given name.
+ */
+const value elementChild(const value& name, const value& l) {
+ const list<value> f = elementChildren(name, l);
+ if (isNil(f))
+ return value();
+ return car(f);
+}
+
}
#endif /* tuscany_element_hpp */
diff --git a/cpp/sca/kernel/kernel-test.cpp b/cpp/sca/kernel/kernel-test.cpp
index 0234f6eb3e..9346e31b71 100644
--- a/cpp/sca/kernel/kernel-test.cpp
+++ b/cpp/sca/kernel/kernel-test.cpp
@@ -650,7 +650,8 @@ bool testFailableMonad() {
assert((m >> success<int, std::string>()) == m);
assert(m >> failableF >> failableG == m >> failableH);
- failable<int, std::string> ooops("ooops");
+ failable<int, std::string> ooops = mkfailure<int, std::string>("ooops");
+ assert(reason(ooops) == "ooops");
assert(ooops >> failableF >> failableG == ooops);
return true;
}
diff --git a/cpp/sca/kernel/list.hpp b/cpp/sca/kernel/list.hpp
index deb4414d98..c21efe173b 100644
--- a/cpp/sca/kernel/list.hpp
+++ b/cpp/sca/kernel/list.hpp
@@ -175,17 +175,10 @@ template<typename T> const list<T> rcons(const T& car, const list<T>& cdr) {
}
/**
- * Construct a list from a single value.
- */
-template<typename T> const list<T> cons(const T& car) {
- return list<T> (car, result(list<T> ()));
-}
-
-/**
* Construct a list of one value.
*/
template<typename T> const list<T> mklist(const T& car) {
- return cons<T>(car);
+ return list<T> (car, result(list<T> ()));
}
/**
diff --git a/cpp/sca/kernel/monad.hpp b/cpp/sca/kernel/monad.hpp
index 9fefbb9f60..98eb3799c0 100644
--- a/cpp/sca/kernel/monad.hpp
+++ b/cpp/sca/kernel/monad.hpp
@@ -68,6 +68,14 @@ private:
};
/**
+ * Write an identity monad to a stream.
+ */
+template<typename V> std::ostream& operator<<(std::ostream& out, const id<V>& m) {
+ out << (V)m;
+ return out;
+}
+
+/**
* Return an identity monad from a value.
*/
template<typename V> const id<V> mkunit(const V& v) {
@@ -134,6 +142,18 @@ private:
};
/**
+ * Write a maybe monad to a stream.
+ */
+template<typename V> std::ostream& operator<<(std::ostream& out, const maybe<V>& m) {
+ if (!hasValue(m)) {
+ out << "nothing";
+ return out;
+ }
+ out << (V)m;
+ return out;
+}
+
+/**
* Return a maybe monad with a value in it.
*/
template<typename V> const maybe<V> mkjust(const V& v) {
@@ -174,20 +194,23 @@ template<typename R, typename V> const maybe<R> operator>>(const maybe<V>& m, co
*/
template<typename V, typename F> class failable {
public:
+ failable() : hasv(false) {
+ }
+
failable(const V& v) : hasv(true), v(v) {
}
- failable(const F& f) : hasv(false), f(f) {
+ failable(const failable<V, F>& m) : hasv(m.hasv) {
+ if (hasv)
+ v = m.v;
+ else
+ f = m.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;
@@ -212,14 +235,32 @@ public:
}
private:
- const bool hasv;
+ bool hasv;
V v;
F f;
+ failable(const bool hasv, const F& f) : hasv(hasv), f(f) {
+ }
+
template<typename A, typename B> friend const bool hasValue(const failable<A, B>& m);
+ template<typename A, typename B> friend const B reason(const failable<A, B>& m);
+ template<typename A, typename B> friend const failable<A, B> mkfailure(const B& f);
};
/**
+ * Write a failable monad to a stream.
+ */
+template<typename V, typename F> std::ostream& operator<<(std::ostream& out, const failable<V, F>& m) {
+ if (!hasValue(m)) {
+ out << reason(m);
+ return out;
+ }
+ const V v = m;
+ out << v;
+ return out;
+}
+
+/**
* Returns a failable monad with a success value in it.
*/
template<typename V, typename F> const failable<V, F> mksuccess(const V& v) {
@@ -231,6 +272,17 @@ template<typename V, typename F> const lambda<failable<V, F>(V)> success() {
}
/**
+ * Returns a failable monad with a failure in it.
+ */
+template<typename V, typename F> const failable<V, F> mkfailure(const F& f) {
+ return failable<V, F>(false, f);
+}
+
+template<typename V, typename F> const lambda<failable<V, F>(V)> failure() {
+ return mkfailure<V, F>;
+}
+
+/**
* Returns true if the monad contains a value.
*/
template<typename V, typename F> const bool hasValue(const failable<V, F>& m) {
@@ -238,6 +290,13 @@ template<typename V, typename F> const bool hasValue(const failable<V, F>& m) {
}
/**
+ * Returns the reason for failure of a failable monad.
+ */
+template<typename V, typename F> const F reason(const failable<V, F>& m) {
+ return m.f;
+}
+
+/**
* 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.
*/
@@ -330,6 +389,16 @@ private:
};
/**
+ * Write a state monad to a stream.
+ */
+template<typename S, typename V> std::ostream& operator<<(std::ostream& out, const state<S, V>& m) {
+ const S s = m;
+ const V v = m;
+ out << '(' << s << ' ' << v << ')';
+ return out;
+}
+
+/**
* Return a state monad carrying a result value.
*/
template<typename S, typename V> struct returnState {
diff --git a/cpp/sca/kernel/value.hpp b/cpp/sca/kernel/value.hpp
index 618bd7b622..d602b30623 100644
--- a/cpp/sca/kernel/value.hpp
+++ b/cpp/sca/kernel/value.hpp
@@ -362,7 +362,9 @@ private:
};
-
+/**
+ * Write a value to a stream.
+ */
std::ostream& operator<<(std::ostream& out, const value& v) {
switch(v.type) {
case value::List:
@@ -399,46 +401,86 @@ std::ostream& operator<<(std::ostream& out, const value& v) {
}
}
+/**
+ * Returns the type of a value.
+ */
const value::ValueType type(const value& v) {
return v.type;
}
+/**
+ * Returns true if a value is nil.
+ */
const bool isNil(const value& value) {
return value.type == value::Undefined;
}
+/**
+ * Returns true if a value is a lambda.
+ */
+const bool isLambda(const value& value) {
+ return value.type == value::Lambda;
+}
+
+/**
+ * Returns true if a value is a string.
+ */
const bool isString(const value& value) {
return value.type == value::String;
}
+/**
+ * Returns true if a value is a symbol.
+ */
const bool isSymbol(const value& value) {
return value.type == value::Symbol;
}
+/**
+ * Returns true if a value is a list.
+ */
const bool isList(const value& value) {
return value.type == value::List;
}
+/**
+ * Returns true if a value is a number.
+ */
const bool isNumber(const value& value) {
return value.type == value::Number;
}
+/**
+ * Returns true if a value is a boolean.
+ */
const bool isBool(const value& value) {
return value.type == value::Bool;
}
+/**
+ * Returns true if a value is a character.
+ */
const bool isChar(const value& value) {
return value.type == value::Char;
}
+/**
+ * Returns true if a value is a pointer.
+ */
const bool isPtr(const value& value) {
return value.type == value::Ptr;
}
+/**
+ * Returns true if a value is a pooled pointer.
+ */
const bool isPoolPtr(const value& value) {
return value.type == value::PoolPtr;
}
+/**
+ * Returns true if a value is a tagged list.
+ */
const bool isTaggedList(const value& exp, value tag) {
if(isList(exp) && !isNil((list<value>)exp))
return car((list<value>)exp) == tag;
diff --git a/cpp/sca/kernel/xml.hpp b/cpp/sca/kernel/xml.hpp
index b7611b8477..8d561557ca 100644
--- a/cpp/sca/kernel/xml.hpp
+++ b/cpp/sca/kernel/xml.hpp
@@ -144,7 +144,7 @@ const value readAttribute(XMLReader& reader) {
*/
const value readToken(XMLReader& reader) {
const int tokenType = reader.read();
- if (tokenType == XMLReader::End)
+ if (tokenType == XMLReader::None || tokenType == XMLReader::End)
return value();
if (tokenType == XMLReader::Element)
return startElement;
@@ -228,7 +228,7 @@ const char* encoding = "UTF-8";
*/
const list<value> expandElementValues(const value& n, const list<value>& l) {
if (isNil(l))
- return list<value>();
+ return l;
return cons<value>(value(cons<value>(element, cons<value>(n, (list<value>)car(l)))), expandElementValues(n, cdr(l)));
}
@@ -240,7 +240,7 @@ const failable<bool, std::string> writeList(const list<value>& l, const xmlTextW
const value token(car(l));
if (isTaggedList(token, attribute)) {
if (xmlTextWriterWriteAttribute(xml, (const xmlChar*)std::string(attributeName(token)).c_str(), (const xmlChar*)std::string(attributeValue(token)).c_str()) < 0)
- return std::string("xmlTextWriterWriteAttribute failed");
+ return mkfailure<bool, std::string>("xmlTextWriterWriteAttribute failed");
} else if (isTaggedList(token, element)) {
@@ -257,7 +257,7 @@ const failable<bool, std::string> writeList(const list<value>& l, const xmlTextW
// Write an element with a single value
if (xmlTextWriterStartElement(xml, (const xmlChar*)std::string(elementName(token)).c_str()) < 0)
- return std::string("xmlTextWriterStartElement failed");
+ return mkfailure<bool, std::string>("xmlTextWriterStartElement failed");
// Write its children
const failable<bool, std::string> w = writeList(elementChildren(token), xml);
@@ -265,14 +265,14 @@ const failable<bool, std::string> writeList(const list<value>& l, const xmlTextW
return w;
if (xmlTextWriterEndElement(xml) < 0)
- return std::string("xmlTextWriterEndElement failed");
+ return mkfailure<bool, 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");
+ return mkfailure<bool, std::string>("xmlTextWriterStartElement failed");
// Write its children
const failable<bool, std::string> w = writeList(elementChildren(token), xml);
@@ -280,13 +280,13 @@ const failable<bool, std::string> writeList(const list<value>& l, const xmlTextW
return w;
if (xmlTextWriterEndElement(xml) < 0)
- return std::string("xmlTextWriterEndElement failed");
+ return mkfailure<bool, std::string>("xmlTextWriterEndElement failed");
}
} else {
// Write XML text
if (xmlTextWriterWriteString(xml, (const xmlChar*)std::string(token).c_str()) < 0)
- return std::string("xmlTextWriterWriteString failed");
+ return mkfailure<bool, std::string>("xmlTextWriterWriteString failed");
}
@@ -299,14 +299,14 @@ const failable<bool, std::string> writeList(const list<value>& l, const xmlTextW
*/
const failable<bool, std::string> write(const list<value>& l, const xmlTextWriterPtr xml) {
if (xmlTextWriterStartDocument(xml, NULL, encoding, NULL) < 0)
- return std::string("xmlTextWriterStartDocument failed");
+ return mkfailure<bool, std::string>("xmlTextWriterStartDocument failed");
const failable<bool, std::string> w = writeList(l, xml);
if (!hasValue(w))
return w;
if (xmlTextWriterEndDocument(xml) < 0)
- return std::string("xmlTextWriterEndDocument failed");
+ return mkfailure<bool, std::string>("xmlTextWriterEndDocument failed");
return true;
}
@@ -337,15 +337,15 @@ template<typename R> const failable<R, std::string> writeXML(const lambda<R(std:
XMLWriteContext<R> cx(reduce, initial);
xmlOutputBufferPtr out = xmlOutputBufferCreateIO(writeCallback<R>, NULL, &cx, NULL);
if (out == NULL)
- return std::string("xmlOutputBufferCreateIO failed");
+ return mkfailure<R, std::string>("xmlOutputBufferCreateIO failed");
xmlTextWriterPtr xml = xmlNewTextWriter(out);
if (xml == NULL)
- return std::string("xmlNewTextWriter failed");
+ return mkfailure<R, std::string>("xmlNewTextWriter failed");
const failable<bool, std::string> w = write(l, xml);
xmlFreeTextWriter(xml);
if (!hasValue(w)) {
- return std::string(w);
+ return mkfailure<R, std::string>(reason(w));
}
return cx.accum;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-16 20:34:52 +0000