summaryrefslogtreecommitdiffstats
path: root/sca-cpp/trunk/modules/scheme
diff options
context:
space:
mode:
Diffstat (limited to 'sca-cpp/trunk/modules/scheme')
-rw-r--r--sca-cpp/trunk/modules/scheme/Makefile.am14
-rw-r--r--sca-cpp/trunk/modules/scheme/driver.hpp2
-rw-r--r--sca-cpp/trunk/modules/scheme/element-value.cpp6
-rw-r--r--sca-cpp/trunk/modules/scheme/element-xml.cpp (renamed from sca-cpp/trunk/modules/scheme/value-xml.cpp)6
-rw-r--r--sca-cpp/trunk/modules/scheme/environment.hpp16
-rw-r--r--sca-cpp/trunk/modules/scheme/eval.hpp10
-rw-r--r--sca-cpp/trunk/modules/scheme/io.hpp150
-rw-r--r--sca-cpp/trunk/modules/scheme/primitive.hpp86
-rw-r--r--sca-cpp/trunk/modules/scheme/scheme-shell.cpp2
-rw-r--r--sca-cpp/trunk/modules/scheme/scheme-test.cpp126
-rw-r--r--sca-cpp/trunk/modules/scheme/scheme-test.hpp34
-rw-r--r--sca-cpp/trunk/modules/scheme/test.scm44
-rw-r--r--sca-cpp/trunk/modules/scheme/value-element.cpp6
-rw-r--r--sca-cpp/trunk/modules/scheme/xml-element.cpp (renamed from sca-cpp/trunk/modules/scheme/xml-value.cpp)8
14 files changed, 325 insertions, 185 deletions
diff --git a/sca-cpp/trunk/modules/scheme/Makefile.am b/sca-cpp/trunk/modules/scheme/Makefile.am
index 130fe14303..460dbb3f82 100644
--- a/sca-cpp/trunk/modules/scheme/Makefile.am
+++ b/sca-cpp/trunk/modules/scheme/Makefile.am
@@ -30,18 +30,18 @@ value_element_LDFLAGS =
element_value_SOURCES = element-value.cpp
element_value_LDFLAGS =
-xml_value_SOURCES = xml-value.cpp
-xml_value_LDFLAGS = -lxml2
+xml_element_SOURCES = xml-element.cpp
+xml_element_LDFLAGS = -lxml2
-value_xml_SOURCES = value-xml.cpp
-value_xml_LDFLAGS = -lxml2
+element_xml_SOURCES = element-xml.cpp
+element_xml_LDFLAGS = -lxml2
json_value_SOURCES = json-value.cpp
-json_value_LDFLAGS = -lmozjs
+json_value_LDFLAGS = -ljansson
value_json_SOURCES = value-json.cpp
-value_json_LDFLAGS = -lmozjs
+value_json_LDFLAGS = -ljansson
noinst_PROGRAMS = scheme-test
-mod_PROGRAMS = scheme-shell element-value value-element xml-value value-xml json-value value-json
+mod_PROGRAMS = scheme-shell element-value value-element xml-element element-xml json-value value-json
TESTS = scheme-test
diff --git a/sca-cpp/trunk/modules/scheme/driver.hpp b/sca-cpp/trunk/modules/scheme/driver.hpp
index 112c226ed1..c94af7bbf7 100644
--- a/sca-cpp/trunk/modules/scheme/driver.hpp
+++ b/sca-cpp/trunk/modules/scheme/driver.hpp
@@ -55,7 +55,7 @@ const bool userPrint(const value val, ostream& out) {
const value evalDriverLoop(istream& in, ostream& out, Env& env) {
promptForInput(evalInputPrompt, out);
- value input = readValue(in);
+ const value input = content(readValue(in));
if (isNil(input))
return input;
const value output = evalExpr(input, env);
diff --git a/sca-cpp/trunk/modules/scheme/element-value.cpp b/sca-cpp/trunk/modules/scheme/element-value.cpp
index 8a443dbdb2..bce6042615 100644
--- a/sca-cpp/trunk/modules/scheme/element-value.cpp
+++ b/sca-cpp/trunk/modules/scheme/element-value.cpp
@@ -31,9 +31,9 @@
namespace tuscany {
namespace scheme {
-int elementValue() {
- const value v = elementsToValues(readValue(cin));
- cout << writeValue(v);
+const int elementValue() {
+ const value v = elementsToValues(content(readValue(cin)));
+ write(content(writeValue(v)), cout);
return 0;
}
diff --git a/sca-cpp/trunk/modules/scheme/value-xml.cpp b/sca-cpp/trunk/modules/scheme/element-xml.cpp
index ff785899c6..c7bc7661ab 100644
--- a/sca-cpp/trunk/modules/scheme/value-xml.cpp
+++ b/sca-cpp/trunk/modules/scheme/element-xml.cpp
@@ -25,15 +25,15 @@
#include "fstream.hpp"
#include "string.hpp"
-#include "xml.hpp"
#include "element.hpp"
+#include "../xml/xml.hpp"
#include "eval.hpp"
namespace tuscany {
namespace scheme {
-int valueXML() {
- failable<list<string> > s = writeXML(readValue(cin));
+const int valueXML() {
+ const failable<list<string> > s = xml::writeElements(content(readValue(cin)));
if (!hasContent(s)) {
cerr << reason(s) << " : " << rcode(s);
return 1;
diff --git a/sca-cpp/trunk/modules/scheme/environment.hpp b/sca-cpp/trunk/modules/scheme/environment.hpp
index 303a37cb3c..1a295c74f4 100644
--- a/sca-cpp/trunk/modules/scheme/environment.hpp
+++ b/sca-cpp/trunk/modules/scheme/environment.hpp
@@ -45,7 +45,7 @@ const value setSymbol("set!");
const value dotSymbol(".");
const Env theEmptyEnvironment() {
- return list<value>();
+ return nilListValue;
}
const bool isDefinition(const value& exp) {
@@ -68,11 +68,11 @@ const gc_ptr<Frame> firstFrame(const Env& env) {
return car(env);
}
-list<value> frameVariables(const Frame& frame) {
+const list<value> frameVariables(const Frame& frame) {
return car((list<value> )frame);
}
-list<value> frameValues(const Frame& frame) {
+const list<value> frameValues(const Frame& frame) {
return cdr((list<value> )frame);
}
@@ -103,8 +103,7 @@ const Frame makeBinding(const Frame& frameSoFar, const list<value>& variables, c
}
const gc_ptr<Frame> makeFrame(const list<value>& variables, const list<value> values) {
- gc_ptr<Frame> frame = new (gc_new<Frame>()) Frame();
- *frame = value(makeBinding(cons(value(list<value>()), list<value>()), variables, values));
+ const gc_ptr<Frame> frame = new (gc_new<Frame>()) Frame(makeBinding(cons(value(nilListValue), nilListValue), variables, values));
return frame;
}
@@ -120,7 +119,7 @@ const value definitionValue(const value& exp) {
const list<value> exps(exp);
if(isSymbol(car(cdr(exps)))) {
if (isNil(cdr(cdr(exps))))
- return value();
+ return nilValue;
return car(cdr(cdr(exps)));
}
const list<value> lexps(car(cdr(exps)));
@@ -140,7 +139,8 @@ const Frame addBindingToFrame(const value& var, const value& val, const Frame& f
}
const bool defineVariable(const value& var, const value& val, Env& env) {
- *firstFrame(env) = addBindingToFrame(var, val, *firstFrame(env));
+ const Frame newFrame = addBindingToFrame(var, val, *firstFrame(env));
+ setvalue(*firstFrame(env), addBindingToFrame(var, val, *firstFrame(env)));
return true;
}
@@ -168,7 +168,7 @@ const value lookupEnvScan(const value& var, const list<value>& vars, const list<
const value lookupEnvLoop(const value& var, const Env& env) {
if(env == theEmptyEnvironment()) {
logStream() << "Unbound variable " << var << endl;
- return value();
+ return nilValue;
}
return lookupEnvScan(var, frameVariables(*firstFrame(env)), frameValues(*firstFrame(env)), env);
}
diff --git a/sca-cpp/trunk/modules/scheme/eval.hpp b/sca-cpp/trunk/modules/scheme/eval.hpp
index 34d1a7bc17..5074471931 100644
--- a/sca-cpp/trunk/modules/scheme/eval.hpp
+++ b/sca-cpp/trunk/modules/scheme/eval.hpp
@@ -147,7 +147,7 @@ const value applyProcedure(const value& procedure, list<value>& arguments) {
return evalSequence(procedureBody(procedure), env);
}
logStream() << "Unknown procedure type " << procedure << endl;
- return value();
+ return nilValue;
}
const value sequenceToExp(const list<value> exps) {
@@ -209,16 +209,16 @@ const value expandClauses(const list<value>& clauses) {
if(isNil(rest))
return sequenceToExp(condActions(first));
logStream() << "else clause isn't last " << clauses << endl;
- return value();
+ return nilValue;
}
return makeIf(condPredicate(first), sequenceToExp(condActions(first)), expandClauses(rest));
}
-value condToIf(const value& exp) {
+const value condToIf(const value& exp) {
return expandClauses(condClauses(exp));
}
-value evalIf(const value& exp, Env& env) {
+const value evalIf(const value& exp, Env& env) {
if(isTrue(evalExpr(ifPredicate(exp), env)))
return evalExpr(ifConsequent(exp), env);
return evalExpr(ifAlternative(exp), env);
@@ -255,7 +255,7 @@ const value evalExpr(const value& exp, Env& env) {
return applyProcedure(evalExpr(operat(exp), env), operandValues);
}
logStream() << "Unknown expression type " << exp << endl;
- return value();
+ return nilValue;
}
const list<value> quotedParameters(const list<value>& p) {
diff --git a/sca-cpp/trunk/modules/scheme/io.hpp b/sca-cpp/trunk/modules/scheme/io.hpp
index 8f9d70e7fe..02f6923c86 100644
--- a/sca-cpp/trunk/modules/scheme/io.hpp
+++ b/sca-cpp/trunk/modules/scheme/io.hpp
@@ -37,39 +37,38 @@
namespace tuscany {
namespace scheme {
-const value rightParenthesis(mklist<value>(")"));
-const value leftParenthesis(mklist<value>("("));
-const value comment(mklist<value>(";"));
+const value rightParenthesis(")");
+const value leftParenthesis("(");
-const double stringToNumber(const string& str) {
+inline const double stringToNumber(const string& str) {
return atof(c_str(str));
}
-const bool isWhitespace(const char ch) {
+inline const bool isWhitespace(const char ch) {
return ch != -1 && isspace(ch);
}
-const bool isIdentifierStart(const char ch) {
+inline const bool isIdentifierStart(const char ch) {
return ch != -1 && !isspace(ch) && !isdigit(ch);
}
-const bool isIdentifierPart(const char ch) {
+inline const bool isIdentifierPart(const char ch) {
return ch != -1 && !isspace(ch) && ch != '(' && ch != ')';
}
-const bool isDigit(const char ch) {
+inline const bool isDigit(const char ch) {
return isdigit(ch) || ch == '.';
}
-const bool isLeftParenthesis(const value& token) {
+inline const bool isLeftParenthesis(const value& token) {
return leftParenthesis == token;
}
-const bool isRightParenthesis(const value& token) {
+inline const bool isRightParenthesis(const value& token) {
return rightParenthesis == token;
}
-const char readChar(istream& in) {
+inline const char readChar(istream& in) {
if(in.eof()) {
return -1;
}
@@ -77,14 +76,14 @@ const char readChar(istream& in) {
return c;
}
-const char peekChar(istream& in) {
+inline const char peekChar(istream& in) {
if(eof(in))
return -1;
char c = (char)peek(in);
return c;
}
-const bool isQuote(const value& token) {
+inline const bool isQuote(const value& token) {
return token == quoteSymbol;
}
@@ -93,9 +92,9 @@ const value readQuoted(istream& in);
const value readIdentifier(const char chr, istream& in);
const value readString(istream& in);
const value readNumber(const char chr, istream& in);
-const value readValue(istream& in);
+const failable<value> readValue(istream& in);
-const failable<value> readToken(istream& in) {
+inline const failable<value> readToken(istream& in) {
const char firstChar = readChar(in);
if(isWhitespace(firstChar))
return readToken(in);
@@ -119,18 +118,19 @@ const failable<value> readToken(istream& in) {
return readToken(in);
}
-const failable<value> skipComment(istream& in) {
- const char nextChar = readChar(in);
- if (nextChar == '\n')
- return readToken(in);
- return skipComment(in);
+inline const failable<value> skipComment(istream& in) {
+ while(true) {
+ const char nextChar = readChar(in);
+ if (nextChar == '\n')
+ return readToken(in);
+ }
}
-const value readQuoted(istream& in) {
- return mklist(quoteSymbol, readValue(in));
+inline const value readQuoted(istream& in) {
+ return mklist(quoteSymbol, content(readValue(in)));
}
-const list<value> readList(const list<value>& listSoFar, istream& in) {
+inline const list<value> readList(const list<value>& listSoFar, istream& in) {
const failable<value> ftoken = readToken(in);
if (!hasContent(ftoken))
return reverse(listSoFar);
@@ -142,95 +142,97 @@ const list<value> readList(const list<value>& listSoFar, istream& in) {
return readList(cons(token, listSoFar), in);
}
-const string listToString(const list<char>& l) {
- if(isNil(l))
- return "";
- const char buf[1] = { car(l) };
- return string(buf, 1) + listToString(cdr(l));
-}
-
-const list<char> readIdentifierHelper(const list<char>& listSoFar, istream& in) {
- const char nextChar = peekChar(in);
- if(isIdentifierPart(nextChar))
- return readIdentifierHelper(cons(readChar(in), listSoFar), in);
- return reverse(listSoFar);
+inline const string readIdentifierHelper(const char chr, istream& in) {
+ ostringstream buf;
+ buf << chr;
+ while(true) {
+ const char nextChar = peekChar(in);
+ if(!isIdentifierPart(nextChar))
+ return str(buf);
+ buf << readChar(in);
+ }
}
-const value readIdentifier(const char chr, istream& in) {
- const value val = c_str(listToString(readIdentifierHelper(mklist(chr), in)));
+inline const value readIdentifier(const char chr, istream& in) {
+ const value val = c_str(readIdentifierHelper(chr, in));
if (val == "false")
return value((bool)false);
if (val == "true")
return value((bool)true);
if (val == "nil")
- return value();
+ return nilValue;
return val;
}
-const list<char> readStringHelper(const list<char>& listSoFar, istream& in) {
- const char nextChar = readChar(in);
- if(nextChar == -1 || nextChar == '"')
- return reverse(listSoFar);
- if (nextChar == '\\') {
- const char escapedChar = readChar(in);
- if (escapedChar == -1)
- return reverse(listSoFar);
- return readStringHelper(cons(escapedChar, listSoFar), in);
+inline const value readString(istream& in) {
+ ostringstream buf;
+ while(true) {
+ const char nextChar = readChar(in);
+ if(nextChar == -1 || nextChar == '"')
+ return (value)str(buf);
+ if (nextChar == '\\') {
+ const char escapedChar = readChar(in);
+ if (escapedChar == -1)
+ return (value)str(buf);
+ buf << escapedChar;
+ }
+ buf << nextChar;
}
- return readStringHelper(cons(nextChar, listSoFar), in);
}
-const value readString(istream& in) {
- return listToString(readStringHelper(list<char>(), in));
-}
-
-const list<char> readNumberHelper(const list<char>& listSoFar, istream& in) {
- const char nextChar = peekChar(in);
- if(isDigit(nextChar))
- return readNumberHelper(cons(readChar(in), listSoFar), in);
- return reverse(listSoFar);
-}
-
-const value readNumber(const char chr, istream& in) {
- return stringToNumber(listToString(readNumberHelper(mklist(chr), in)));
+inline const value readNumber(const char chr, istream& in) {
+ ostringstream buf;
+ buf << chr;
+ while(true) {
+ const char nextChar = peekChar(in);
+ if(!isDigit(nextChar))
+ return stringToNumber(str(buf));
+ buf << readChar(in);
+ }
}
-const value readValue(istream& in) {
+inline const failable<value> readValue(istream& in) {
const failable<value> fnextToken = readToken(in);
if (!hasContent(fnextToken))
- return value();
+ return nilValue;
const value nextToken = content(fnextToken);
if(isLeftParenthesis(nextToken))
- return readList(list<value>(), in);
+ return (value)readList(nilListValue, in);
return nextToken;
}
-const value readValue(const string s) {
+inline const failable<value> readValue(const string& s) {
istringstream in(s);
const failable<value> fnextToken = readToken(in);
if (!hasContent(fnextToken))
- return value();
+ return nilValue;
const value nextToken = content(fnextToken);
if(isLeftParenthesis(nextToken))
- return readList(list<value>(), in);
+ return (value)readList(nilListValue, in);
return nextToken;
}
-const bool writeValue(const value& val, ostream& out) {
+inline const failable<value> readValue(const list<string>& l) {
+ ostringstream os;
+ write(l, os);
+ return readValue(str(os));
+}
+
+inline const failable<ostream&> writeValue(const value& val, ostream& out) {
out << val;
- return true;
+ return out;
}
-const string writeValue(const value& val) {
+inline const failable<list<string> > writeValue(const value& val) {
ostringstream out;
out << val;
- return str(out);
+ return mklist<string>(str(out));
}
-const value readScript(istream& in) {
- const value val = readValue(in);
+inline const value readScript(istream& in) {
+ const value val = content(readValue(in));
if (isNil(val))
- return list<value>();
+ return nilListValue;
return cons(val, (list<value>)readScript(in));
}
diff --git a/sca-cpp/trunk/modules/scheme/primitive.hpp b/sca-cpp/trunk/modules/scheme/primitive.hpp
index 59aee12073..2e0c4f62dd 100644
--- a/sca-cpp/trunk/modules/scheme/primitive.hpp
+++ b/sca-cpp/trunk/modules/scheme/primitive.hpp
@@ -40,7 +40,7 @@ const value quoteSymbol("'");
const value lambdaSymbol("lambda");
#ifdef WANT_THREADS
-perthread_ptr<ostream> displayOutStream;
+const perthread_ptr<ostream> displayOutStream;
#else
ostream* displayOutStream = NULL;
#endif
@@ -51,49 +51,49 @@ perthread_ptr<ostream> logOutStream;
ostream* logOutStream = NULL;
#endif
-const bool setupDisplay(ostream& out) {
+inline const bool setupDisplay(ostream& out) {
displayOutStream = &out;
return true;
}
-ostream& displayStream() {
+inline ostream& displayStream() {
if (displayOutStream == NULL)
return cout;
return *displayOutStream;
}
-const bool setupLog(ostream& out) {
+inline const bool setupLog(ostream& out) {
logOutStream = &out;
return true;
}
-ostream& logStream() {
+inline ostream& logStream() {
if (logOutStream == NULL)
return cerr;
return *logOutStream;
}
-const value carProc(const list<value>& args) {
+inline const value carProc(const list<value>& args) {
return car((list<value> )car(args));
}
-const value cdrProc(const list<value>& args) {
+inline const value cdrProc(const list<value>& args) {
return cdr((list<value> )car(args));
}
-const value consProc(const list<value>& args) {
+inline const value consProc(const list<value>& args) {
return cons(car(args), (list<value> )cadr(args));
}
-const value listProc(const list<value>& args) {
+inline const value listProc(const list<value>& args) {
return args;
}
-const value assocProc(const list<value>& args) {
+inline const value assocProc(const list<value>& args) {
return assoc(car(args), (list<list<value> >)cadr(args));
}
-const value nulProc(const list<value>& args) {
+inline const value nulProc(const list<value>& args) {
const value v(car(args));
if (isNil(v))
return true;
@@ -102,31 +102,31 @@ const value nulProc(const list<value>& args) {
return false;
}
-const value equalProc(const list<value>& args) {
+inline const value equalProc(const list<value>& args) {
return (bool)(car(args) == cadr(args));
}
-const value addProc(const list<value>& args) {
+inline const value addProc(const list<value>& args) {
if (isNil(cdr(args)))
return (double)car(args);
return (double)car(args) + (double)cadr(args);
}
-const value subProc(const list<value>& args) {
+inline const value subProc(const list<value>& args) {
if (isNil(cdr(args)))
return (double)0 - (double)car(args);
return (double)car(args) - (double)cadr(args);
}
-const value mulProc(const list<value>& args) {
+inline const value mulProc(const list<value>& args) {
return (double)car(args) * (double)cadr(args);
}
-const value divProc(const list<value>& args) {
+inline const value divProc(const list<value>& args) {
return (double)car(args) / (double)cadr(args);
}
-const value displayProc(const list<value>& args) {
+inline const value displayProc(const list<value>& args) {
if (isNil(args)) {
displayStream() << endl;
return true;
@@ -135,7 +135,7 @@ const value displayProc(const list<value>& args) {
return displayProc(cdr(args));
}
-const value logProc(const list<value>& args) {
+inline const value logProc(const list<value>& args) {
if (isNil(args)) {
logStream() << endl;
return true;
@@ -144,52 +144,52 @@ const value logProc(const list<value>& args) {
return logProc(cdr(args));
}
-const value uuidProc(unused const list<value>& args) {
+inline const value uuidProc(unused const list<value>& args) {
return mkuuid();
}
-const value cadrProc(const list<value>& args) {
+inline const value cadrProc(const list<value>& args) {
return cadr((list<value> )car(args));
}
-const value caddrProc(const list<value>& args) {
+inline const value caddrProc(const list<value>& args) {
return caddr((list<value> )car(args));
}
-const value cadddrProc(const list<value>& args) {
+inline const value cadddrProc(const list<value>& args) {
return cadddr((list<value> )car(args));
}
-const value cddrProc(const list<value>& args) {
+inline const value cddrProc(const list<value>& args) {
return cddr((list<value> )car(args));
}
-const value cdddrProc(const list<value>& args) {
+inline const value cdddrProc(const list<value>& args) {
return cdddr((list<value> )car(args));
}
-const value appendProc(const list<value>& args) {
+inline const value appendProc(const list<value>& args) {
return append((list<value> )car(args), (list<value>)cadr(args));
}
-const value startProc(unused const list<value>& args) {
- return lambda<value(const list<value>&)>();
+inline const value startProc(unused const list<value>& args) {
+ return lvvlambda();
}
-const value stopProc(unused const list<value>& args) {
- return lambda<value(const list<value>&)>();
+inline const value stopProc(unused const list<value>& args) {
+ return lvvlambda();
}
-const value applyPrimitiveProcedure(const value& proc, list<value>& args) {
- const lambda<value(const list<value>&)> func(cadr((list<value>)proc));
+inline const value applyPrimitiveProcedure(const value& proc, list<value>& args) {
+ const lvvlambda func(cadr((list<value>)proc));
return func(args);
}
-const bool isPrimitiveProcedure(const value& proc) {
+inline const bool isPrimitiveProcedure(const value& proc) {
return isTaggedList(proc, primitiveSymbol);
}
-const bool isSelfEvaluating(const value& exp) {
+inline const bool isSelfEvaluating(const value& exp) {
if(isNil(exp))
return true;
if(isNumber(exp))
@@ -203,15 +203,15 @@ const bool isSelfEvaluating(const value& exp) {
return false;
}
-const value primitiveImplementation(const list<value>& proc) {
+inline const value primitiveImplementation(const list<value>& proc) {
return car(cdr(proc));
}
-template<typename F> const value primitiveProcedure(const F& f) {
- return mklist<value>(primitiveSymbol, (lambda<value(const list<value>&)>)f);
+template<typename F> inline const value primitiveProcedure(const F& f) {
+ return mklist<value>(primitiveSymbol, (lvvlambda)f);
}
-const list<value> primitiveProcedureNames() {
+inline const list<value> primitiveProcedureNames() {
return mklist<value>("car")
+ "cdr"
+ "cons"
@@ -237,7 +237,7 @@ const list<value> primitiveProcedureNames() {
+ "stop";
}
-const list<value> primitiveProcedureObjects() {
+inline const list<value> primitiveProcedureObjects() {
return mklist(primitiveProcedure(carProc))
+ primitiveProcedure(cdrProc)
+ primitiveProcedure(consProc)
@@ -263,23 +263,23 @@ const list<value> primitiveProcedureObjects() {
+ primitiveProcedure(stopProc);
}
-const bool isFalse(const value& exp) {
+inline const bool isFalse(const value& exp) {
return (bool)exp == false;
}
-const bool isTrue(const value& exp) {
+inline const bool isTrue(const value& exp) {
return (bool)exp == true;
}
-const bool isQuoted(const value& exp) {
+inline const bool isQuoted(const value& exp) {
return isTaggedList(exp, quoteSymbol);
}
-const value textOfQuotation(const value& exp) {
+inline const value textOfQuotation(const value& exp) {
return car(cdr((list<value> )exp));
}
-const value makeLambda(const list<value>& parameters, const list<value>& body) {
+inline const value makeLambda(const list<value>& parameters, const list<value>& body) {
return cons(lambdaSymbol, cons<value>(parameters, body));
}
diff --git a/sca-cpp/trunk/modules/scheme/scheme-shell.cpp b/sca-cpp/trunk/modules/scheme/scheme-shell.cpp
index 4aa67c2375..96ea5e834e 100644
--- a/sca-cpp/trunk/modules/scheme/scheme-shell.cpp
+++ b/sca-cpp/trunk/modules/scheme/scheme-shell.cpp
@@ -30,7 +30,7 @@
#include "driver.hpp"
int main() {
- tuscany::gc_scoped_pool pool;
+ const tuscany::gc_scoped_pool pool;
tuscany::scheme::evalDriverRun(tuscany::cin, tuscany::cout);
return 0;
}
diff --git a/sca-cpp/trunk/modules/scheme/scheme-test.cpp b/sca-cpp/trunk/modules/scheme/scheme-test.cpp
index 5b69b8e588..e83f99456f 100644
--- a/sca-cpp/trunk/modules/scheme/scheme-test.cpp
+++ b/sca-cpp/trunk/modules/scheme/scheme-test.cpp
@@ -26,14 +26,16 @@
#include <assert.h>
#include "stream.hpp"
#include "string.hpp"
+#include "perf.hpp"
#include "driver.hpp"
+#include "scheme-test.hpp"
namespace tuscany {
namespace scheme {
-bool testEnv() {
- gc_scoped_pool pool;
- Env globalEnv = list<value>();
+const bool testEnv() {
+ const gc_scoped_pool pool;
+ Env globalEnv = nilListValue;
Env env = extendEnvironment(mklist<value>("a"), mklist<value>(1), globalEnv);
defineVariable("x", env, env);
assert(lookupVariableValue(value("x"), env) == env);
@@ -41,7 +43,7 @@ bool testEnv() {
return true;
}
-bool testEnvGC() {
+const bool testEnvGC() {
resetLambdaCounters();
resetListCounters();
resetValueCounters();
@@ -52,49 +54,49 @@ bool testEnvGC() {
return true;
}
-bool testRead() {
+const bool testRead() {
istringstream is("abcd");
- assert(readValue(is) == "abcd");
+ assert(content(readValue(is)) == "abcd");
istringstream is2("123");
- assert(readValue(is2) == value(123));
+ assert(content(readValue(is2)) == value(123));
istringstream is3("(abcd)");
- assert(readValue(is3) == mklist(value("abcd")));
+ assert(content(readValue(is3)) == mklist(value("abcd")));
istringstream is4("(abcd xyz)");
- assert(readValue(is4) == mklist<value>("abcd", "xyz"));
+ assert(content(readValue(is4)) == mklist<value>("abcd", "xyz"));
istringstream is5("(abcd (xyz tuv))");
- assert(readValue(is5) == mklist<value>("abcd", mklist<value>("xyz", "tuv")));
+ assert(content(readValue(is5)) == mklist<value>("abcd", mklist<value>("xyz", "tuv")));
return true;
}
-bool testWrite() {
+const bool testWrite() {
{
- const list<value> i = list<value>()
- + (list<value>() + "item" + "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83b"
- + (list<value>() + "item"
- + (list<value>() + "name" + "Apple")
- + (list<value>() + "price" + "$2.99")))
- + (list<value>() + "item" + "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83c"
- + (list<value>() + "item"
- + (list<value>() + "name" + "Orange")
- + (list<value>() + "price" + "$3.55")));
+ const list<value> i = nilListValue
+ + (nilListValue + "item" + "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83b"
+ + (nilListValue + "item"
+ + (nilListValue + "name" + "Apple")
+ + (nilListValue + "price" + "$2.99")))
+ + (nilListValue + "item" + "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83c"
+ + (nilListValue + "item"
+ + (nilListValue + "name" + "Orange")
+ + (nilListValue + "price" + "$3.55")));
const list<value> a = cons<value>("Feed", cons<value>("feed-1234", i));
ostringstream os;
writeValue(a, os);
istringstream is(str(os));
- assert(readValue(is) == a);
+ assert(content(readValue(is)) == a);
}
{
- const list<value> i = mklist<value>("x", value());
+ const list<value> i = mklist<value>("x", nilValue);
const list<value> a = mklist<value>(i);
ostringstream os;
writeValue(a, os);
istringstream is(str(os));
- assert(readValue(is) == a);
+ assert(content(readValue(is)) == a);
}
return true;
}
@@ -147,8 +149,8 @@ const string evalOutput(const string& scm) {
return str(os);
}
-bool testEval() {
- gc_scoped_pool pool;
+const bool testEval() {
+ const gc_scoped_pool pool;
assert(contains(evalOutput(testSchemeNumber), "testNumber ok"));
assert(contains(evalOutput(testSchemeString), "testString ok"));
assert(contains(evalOutput(testSchemeDefinition), "testDefinition ok"));
@@ -161,8 +163,8 @@ bool testEval() {
return true;
}
-bool testEvalExpr() {
- gc_scoped_pool pool;
+const bool testEvalExpr() {
+ const gc_scoped_pool pool;
const value exp = mklist<value>("+", 2, 3);
Env env = setupEnvironment();
const value r = evalExpr(exp, env);
@@ -170,8 +172,8 @@ bool testEvalExpr() {
return true;
}
-bool testEvalRun() {
- gc_scoped_pool pool;
+const bool testEvalRun() {
+ const gc_scoped_pool pool;
evalDriverRun(cin, cout);
return true;
}
@@ -188,8 +190,8 @@ const string testReturnLambda(
const string testCallLambda(
"(define (testCallLambda l x y) (l x y))");
-bool testEvalLambda() {
- gc_scoped_pool pool;
+const bool testEvalLambda() {
+ const gc_scoped_pool pool;
Env env = setupEnvironment();
const value trl = mklist<value>("testReturnLambda");
@@ -208,7 +210,18 @@ bool testEvalLambda() {
return true;
}
-bool testEvalGC() {
+const bool testEvalScript() {
+ const gc_scoped_pool pool;
+ Env env = setupEnvironment();
+ ifstream is("test.scm");
+ const value script = readScript(is);
+ const value expr = mklist<value>("echo", string("x"));
+ const value res = evalScript(expr, script, env);
+ assert(res == string("x"));
+ return true;
+}
+
+const bool testEvalGC() {
resetLambdaCounters();
resetListCounters();
resetValueCounters();
@@ -221,11 +234,55 @@ bool testEvalGC() {
return true;
}
+const string testCustomer = "((customer (@name \"jdoe\") (account (id \"1234\") (@balance 1000)) (address (@city \"san francisco\") (@state \"ca\"))))";
+
+const bool testReadWrite() {
+ const gc_scoped_pool pool;
+
+ istringstream is(testCustomer);
+ const value r = content(readValue(is));
+
+ ostringstream os;
+ writeValue(r, os);
+ //assert(str(os) == testCustomer);
+ return true;
+}
+
+const bool testReadWritePerf() {
+ const gc_scoped_pool pool;
+
+ const blambda rwl = blambda(testReadWrite);
+ cout << "Scheme read + write test " << time(rwl, 5, 200) << " ms" << endl;
+
+ return true;
+}
+
+const bool testReadWriteBigDoc() {
+ const gc_scoped_pool pool;
+
+ istringstream is(testBigDoc);
+ const value r = content(readValue(is));
+
+ ostringstream os;
+ writeValue(r, os);
+ //assert(str(os) == testBigDoc);
+ return true;
+}
+
+const bool testReadWriteBigDocPerf() {
+ const gc_scoped_pool pool;
+
+ const blambda rwl = blambda(testReadWriteBigDoc);
+ cout << "Scheme big doc read + write test " << time(rwl, 5, 200) << " ms" << endl;
+
+ return true;
+}
+
}
}
int main() {
- tuscany::gc_scoped_pool p;
+ const tuscany::gc_scoped_pool p;
tuscany::cout << "Testing..." << tuscany::endl;
tuscany::scheme::testEnv();
@@ -235,7 +292,10 @@ int main() {
tuscany::scheme::testEval();
tuscany::scheme::testEvalExpr();
tuscany::scheme::testEvalLambda();
+ tuscany::scheme::testEvalScript();
tuscany::scheme::testEvalGC();
+ tuscany::scheme::testReadWritePerf();
+ tuscany::scheme::testReadWriteBigDocPerf();
tuscany::cout << "OK" << tuscany::endl;
return 0;
diff --git a/sca-cpp/trunk/modules/scheme/scheme-test.hpp b/sca-cpp/trunk/modules/scheme/scheme-test.hpp
new file mode 100644
index 0000000000..67f32344a8
--- /dev/null
+++ b/sca-cpp/trunk/modules/scheme/scheme-test.hpp
@@ -0,0 +1,34 @@
+/*
+ * 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$ */
+
+/**
+ * Test Scheme doc.
+ */
+
+namespace tuscany {
+namespace scheme {
+
+const string testBigDoc = "((feed (title \"Search Results\") (id \"search\") (entry (title \"An empty app template\") (id \"new\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"An empty test app\") (id \"test\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Check my public social data\") (id \"me360\") (author \"admin@example.com\") (updated \"Apr 28, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"nearme\") (id \"nearme\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"nearme2\") (id \"nearme2\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Our photos of an event\") (id \"ourphotos\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"My online store\") (id \"shoppingcart\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Slice\") (id \"slice\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test animation components\") (id \"testanimation\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test database components\") (id \"testdb\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test event components\") (id \"testevents\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test HTTP components\") (id \"testhttp\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test logic components\") (id \"testlogic\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test search components\") (id \"testsearch\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test HTTP components\") (id \"testhttp\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test social components\") (id \"testsocial\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test text processing components\") (id \"testtext\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test URL components\") (id \"testurl\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test values and lists\") (id \"testvalues\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test widgets\") (id \"testwidgets\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test more widgets\") (id \"testwidgets2\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test HTML generator components\") (id \"testwidgets3\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"jsdtest\") (id \"jsdtest\") (author \"jsdelfino\") (updated \"Jul 27, 2012\") (content (stats (description \"Test app\")))) (entry (title \"SMS send service\") (id \"twsms\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"boao\") (id \"boao\") (author \"jsdelfino\") (updated \"2012-10-12T12:06:59+00:00\") (content (stats (description \"Sample app\")))) (entry (title \"An empty test app\") (id \"test\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"An empty app template\") (id \"new\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"nearme\") (id \"nearme\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"nearme2\") (id \"nearme2\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Our photos of an event\") (id \"ourphotos\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"My online store\") (id \"shoppingcart\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Slice\") (id \"slice\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test animation components\") (id \"testanimation\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test database components\") (id \"testdb\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test event components\") (id \"testevents\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test social components\") (id \"testsocial\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test HTTP components\") (id \"testhttp\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test logic components\") (id \"testlogic\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test search components\") (id \"testsearch\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test HTTP components\") (id \"testhttp\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test text processing components\") (id \"testtext\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test URL components\") (id \"testurl\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test values and lists\") (id \"testvalues\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test widgets\") (id \"testwidgets\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test more widgets\") (id \"testwidgets2\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Test HTML generator components\") (id \"testwidgets3\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"test9\") (id \"test9\") (author \"jsdelfino\") (updated \"2012-09-25T06:17:18+00:00\") (content (stats (description \"Sample app\")))) (entry (title \"SMS send service\") (id \"twsms\") (author \"admin@example.com\") (updated \"Jan 01, 2012\") (content (stats (description \"Sample app\")))) (entry (title \"Check my public social data\") (id \"me360\") (author \"admin@example.com\") (updated \"Apr 28, 2012\") (content (stats (description \"Sample app\"))))))";
+
+
+}
+}
+
diff --git a/sca-cpp/trunk/modules/scheme/test.scm b/sca-cpp/trunk/modules/scheme/test.scm
new file mode 100644
index 0000000000..4bbff6e5c2
--- /dev/null
+++ b/sca-cpp/trunk/modules/scheme/test.scm
@@ -0,0 +1,44 @@
+; 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.
+
+; JSON-RPC test case
+
+(define (echo x) x)
+
+; ATOMPub test case
+
+(define (get id)
+ (if (nul id)
+ '((feed (title "Sample Feed") (id "123456789") (entry
+ (((title "Item") (id "111") (content (item (name "Apple") (currencyCode "USD") (currencySymbol "$") (price 2.99))))
+ ((title "Item") (id "222") (content (item (name "Orange") (currencyCode "USD") (currencySymbol "$") (price 3.55))))
+ ((title "Item") (id "333") (content (item (name "Pear") (currencyCode "USD") (currencySymbol "$") (price 1.55))))))))
+
+ (list (list 'entry '(title "Item") (list 'id (car id)) '(content (item (name "Apple") (currencyCode "USD") (currencySymbol "$") (price 2.99))))))
+)
+
+(define (post collection item)
+ '("123456789")
+)
+
+(define (put id item)
+ true
+)
+
+(define (delete id)
+ true
+)
diff --git a/sca-cpp/trunk/modules/scheme/value-element.cpp b/sca-cpp/trunk/modules/scheme/value-element.cpp
index a4acdaf2d7..af5eac9b57 100644
--- a/sca-cpp/trunk/modules/scheme/value-element.cpp
+++ b/sca-cpp/trunk/modules/scheme/value-element.cpp
@@ -31,9 +31,9 @@
namespace tuscany {
namespace scheme {
-int valueElement() {
- const value v = valuesToElements(readValue(cin));
- cout << writeValue(v);
+const int valueElement() {
+ const value v = valuesToElements(content(readValue(cin)));
+ write(content(writeValue(v)), cout);
return 0;
}
diff --git a/sca-cpp/trunk/modules/scheme/xml-value.cpp b/sca-cpp/trunk/modules/scheme/xml-element.cpp
index d88f754aa5..2050004895 100644
--- a/sca-cpp/trunk/modules/scheme/xml-value.cpp
+++ b/sca-cpp/trunk/modules/scheme/xml-element.cpp
@@ -25,16 +25,16 @@
#include "fstream.hpp"
#include "string.hpp"
-#include "xml.hpp"
#include "element.hpp"
+#include "../xml/xml.hpp"
#include "eval.hpp"
namespace tuscany {
namespace scheme {
-int xmlValue() {
- const value v = readXML(streamList(cin));
- cout << writeValue(v);
+const int xmlValue() {
+ const value v = content(xml::readElements(streamList(cin)));
+ write(content(writeValue(v)), cout);
return 0;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-13 17:59:26 +0000