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

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;
 }