summaryrefslogtreecommitdiffstats
path: root/cpp/sca
diff options
context:
space:
mode:
authorjsdelfino <jsdelfino@13f79535-47bb-0310-9956-ffa450edef68>2009-11-16 06:01:33 +0000
committerjsdelfino <jsdelfino@13f79535-47bb-0310-9956-ffa450edef68>2009-11-16 06:01:33 +0000
commitada8802640aa232d34b1fe2793b9f52cd62b41f1 (patch)
treeb72a576c33e5593e7d2842339f06e5e1b2d9faae /cpp/sca
parent4109b6c23b5169463bd493347dddb1ab58aa0860 (diff)
Fixed parsing of comments. Added functions to read scripts and more test cases.
git-svn-id: http://svn.us.apache.org/repos/asf/tuscany@880600 13f79535-47bb-0310-9956-ffa450edef68
Diffstat (limited to 'cpp/sca')
-rw-r--r--cpp/sca/modules/eval/eval-test.cpp45
-rw-r--r--cpp/sca/modules/eval/eval.hpp29
-rw-r--r--cpp/sca/modules/eval/io.hpp18
-rw-r--r--cpp/sca/modules/eval/primitive.hpp35
4 files changed, 99 insertions, 28 deletions
diff --git a/cpp/sca/modules/eval/eval-test.cpp b/cpp/sca/modules/eval/eval-test.cpp
index 7d92c79eba..984b17b26d 100644
--- a/cpp/sca/modules/eval/eval-test.cpp
+++ b/cpp/sca/modules/eval/eval-test.cpp
@@ -167,11 +167,50 @@ bool testEvalExpr() {
return true;
}
+bool testEvalRun() {
+ evalDriverRun(std::cin, std::cout);
+ return true;
+}
+
+const value mult(const list<value>& args) {
+ const double x = car(args);
+ const double y = cadr(args);
+ return x * y;
+}
+
+const std::string testReturnLambda(
+ "(define (testReturnLambda) * )");
+
+const std::string testCallLambda(
+ "(define (testCallLambda l x y) (l x y))");
+
+bool testEvalLambda() {
+ gc_pool pool;
+ Env env = setupEnvironment(pool);
+
+ const value trl = mklist<value>("testReturnLambda");
+ std::istringstream trlis(testReturnLambda);
+ const value trlv = evalScript(trl, trlis, env, pool);
+
+ std::istringstream tclis(testCallLambda);
+ const value tcl = cons<value>("testCallLambda", quotedParameters(mklist<value>(trlv, 2, 3)));
+ const value tclv = evalScript(tcl, tclis, env, pool);
+ assert(tclv == value(6));
+
+ std::istringstream tcelis(testCallLambda);
+ const value tcel = cons<value>("testCallLambda", quotedParameters(mklist<value>(primitiveProcedure(mult), 3, 4)));
+ const value tcelv = evalScript(tcel, tcelis, env, pool);
+ assert(tcelv == value(12));
+ return true;
+}
+
bool testEvalGC() {
resetLambdaCounters();
resetListCounters();
resetValueCounters();
testEval();
+ testEvalExpr();
+ testEvalLambda();
assert(countValues == 0);
assert(countLambdas == 0);
assert(countlists == 0);
@@ -181,11 +220,6 @@ bool testEvalGC() {
return true;
}
-bool testEvalRun() {
- evalDriverRun(std::cin, std::cout);
- return true;
-}
-
}
}
@@ -198,6 +232,7 @@ int main() {
tuscany::eval::testWrite();
tuscany::eval::testEval();
tuscany::eval::testEvalExpr();
+ tuscany::eval::testEvalLambda();
tuscany::eval::testEvalGC();
std::cout << "OK" << std::endl;
diff --git a/cpp/sca/modules/eval/eval.hpp b/cpp/sca/modules/eval/eval.hpp
index 01d242f07b..8c9ecfdecc 100644
--- a/cpp/sca/modules/eval/eval.hpp
+++ b/cpp/sca/modules/eval/eval.hpp
@@ -54,7 +54,7 @@ const list<value> beginActions(const value& exp) {
return cdr((list<value> )exp);
}
-const bool isLambda(const value& exp) {
+const bool isLambdaExpr(const value& exp) {
return isTaggedList(exp, lambdaSymbol);
}
@@ -141,7 +141,7 @@ const value evalSequence(const list<value>& exps, Env& env, const gc_pool& pool)
const value applyProcedure(const value& procedure, list<value>& arguments, const gc_pool& pool) {
if(isPrimitiveProcedure(procedure))
- return applyPrimitiveProcedure(procedure, arguments);
+ return applyPrimitiveProcedure(procedure, arguments, pool);
if(isCompoundProcedure(procedure)) {
Env env = extendEnvironment(procedureParameters(procedure), arguments, procedureEnvironment(procedure), pool);
return evalSequence(procedureBody(procedure), env, pool);
@@ -152,7 +152,7 @@ const value applyProcedure(const value& procedure, list<value>& arguments, const
const value sequenceToExp(const list<value> exps) {
if(isNil(exps))
- return list<value>();
+ return exps;
if(isLastExp(exps))
return firstExp(exps);
return makeBegin(exps);
@@ -242,7 +242,7 @@ const value evalExpr(const value& exp, Env& env, const gc_pool& pool) {
return evalSequence(beginActions(exp), env, pool);
if(isCond(exp))
return evalExpr(condToIf(exp), env, pool);
- if(isLambda(exp))
+ if(isLambdaExpr(exp))
return makeProcedure(lambdaParameters(exp), lambdaBody(exp), env);
if(isVariable(exp))
return lookupVariableValue(exp, env);
@@ -264,6 +264,27 @@ const list<value> quotedParameters(const list<value>& p) {
return cons<value>(mklist<value>(quoteSymbol, car(p)), quotedParameters(cdr(p)));
}
+/**
+ * Evaluate an expression against a script provided as a list of values.
+ */
+const value evalScriptLoop(const value& expr, const list<value>& script, eval::Env& globalEnv, const gc_pool& pool) {
+ if (isNil(script))
+ return eval::evalExpr(expr, globalEnv, pool);
+ eval::evalExpr(car(script), globalEnv, pool);
+ return evalScriptLoop(expr, cdr(script), globalEnv, pool);
+}
+
+const value evalScript(const value& expr, const value& script, Env& env, const gc_pool& pool) {
+ return evalScriptLoop(expr, script, env, pool);
+}
+
+/**
+ * Evaluate an expression against a script provided as an input stream.
+ */
+const value evalScript(const value& expr, std::istream& is, Env& env, const gc_pool& pool) {
+ return evalScript(expr, readScript(is), env, pool);
+}
+
}
}
#endif /* tuscany_eval_eval_hpp */
diff --git a/cpp/sca/modules/eval/io.hpp b/cpp/sca/modules/eval/io.hpp
index 2a55e67bbf..a898a11440 100644
--- a/cpp/sca/modules/eval/io.hpp
+++ b/cpp/sca/modules/eval/io.hpp
@@ -92,6 +92,7 @@ const bool isQuote(const value& token) {
return token == quoteSymbol;
}
+const value skipComment(std::istream& in);
const value readQuoted(std::istream& in);
const value readIdentifier(const char chr, std::istream& in);
const value readString(const char chr, std::istream& in);
@@ -102,6 +103,8 @@ const value readToken(std::istream& in) {
const char firstChar = readChar(in);
if(isWhitespace(firstChar))
return readToken(in);
+ if(firstChar == ';')
+ return skipComment(in);
if(firstChar == '\'')
return readQuoted(in);
if(firstChar == '(')
@@ -120,6 +123,13 @@ const value readToken(std::istream& in) {
return readToken(in);
}
+const value skipComment(std::istream& in) {
+ const char nextChar = readChar(in);
+ if (nextChar == '\n')
+ return readToken(in);
+ return skipComment(in);
+}
+
const value readQuoted(std::istream& in) {
return mklist(quoteSymbol, readValue(in));
}
@@ -181,6 +191,14 @@ const value readValue(std::istream& in) {
const bool writeValue(const value& val, std::ostream& out) {
out << val;
+ return true;
+}
+
+const value readScript(std::istream& in) {
+ const value val = readValue(in);
+ if (isNil(val))
+ return list<value>();
+ return cons(val, (list<value>)readScript(in));
}
}
diff --git a/cpp/sca/modules/eval/primitive.hpp b/cpp/sca/modules/eval/primitive.hpp
index 9d62d6b1a6..bd36c0e226 100644
--- a/cpp/sca/modules/eval/primitive.hpp
+++ b/cpp/sca/modules/eval/primitive.hpp
@@ -47,60 +47,57 @@ const bool setupDisplay(std::ostream& out) {
return true;
}
-const value carProc(list<value>& args) {
+const value carProc(const list<value>& args) {
return car((list<value> )car(args));
}
-const value cdrProc(list<value>& args) {
+const value cdrProc(const list<value>& args) {
return cdr((list<value> )car(args));
}
-const value consProc(list<value>& args) {
+const value consProc(const list<value>& args) {
return cons(car(args), (list<value> )cadr(args));
}
-const value listProc(list<value>& args) {
+const value listProc(const list<value>& args) {
return args;
}
-const value nulProc(list<value>& args) {
+const value nulProc(const list<value>& args) {
return (bool)isNil(car(args));
}
-const value equalProc(list<value>& args) {
+const value equalProc(const list<value>& args) {
return (bool)(car(args) == cadr(args));
}
-const value addProc(list<value>& args) {
+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(list<value>& args) {
+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(list<value>& args) {
+const value mulProc(const list<value>& args) {
return (double)car(args) * (double)cadr(args);
}
-const value divProc(list<value>& args) {
+const value divProc(const list<value>& args) {
return (double)car(args) / (double)cadr(args);
}
-const value displayProc(list<value>& args) {
+const value displayProc(const list<value>& args) {
*displayOut << car(args);
+ (*displayOut).flush();
return true;
}
-const value commentProc(list<value>& args) {
- return true;
-}
-
-const value uuidProc(list<value>& args) {
+const value uuidProc(const list<value>& args) {
apr_uuid_t uuid;
apr_uuid_get(&uuid);
char buf[APR_UUID_FORMATTED_LENGTH];
@@ -108,7 +105,7 @@ const value uuidProc(list<value>& args) {
return std::string(buf, APR_UUID_FORMATTED_LENGTH);
}
-const value applyPrimitiveProcedure(const value& proc, list<value>& args) {
+const value applyPrimitiveProcedure(const value& proc, list<value>& args, const gc_pool& pool) {
const lambda<value(list<value>&)> func(cadr((list<value>)proc));
return func(args);
}
@@ -128,6 +125,8 @@ const bool isSelfEvaluating(const value& exp) {
return true;
if(isChar(exp))
return true;
+ if(isLambda(exp))
+ return true;
return false;
}
@@ -153,7 +152,6 @@ const list<value> primitiveProcedureNames() {
l = cons<value>("equal?", l);
l = cons<value>("display", l);
l = cons<value>("uuid", l);
- l = cons<value>(";", l);
return l;
}
@@ -171,7 +169,6 @@ const list<value> primitiveProcedureObjects() {
l = cons(primitiveProcedure(equalProc), l);
l = cons(primitiveProcedure(displayProc), l);
l = cons(primitiveProcedure(uuidProc), l);
- l = cons(primitiveProcedure(commentProc), l);
return l;
}