diff options
Diffstat (limited to '')
-rw-r--r-- | cpp/sca/modules/atom/Makefile.am | 4 | ||||
-rw-r--r-- | cpp/sca/modules/eval/Makefile.am | 6 | ||||
-rw-r--r-- | cpp/sca/modules/eval/driver.hpp | 12 | ||||
-rw-r--r-- | cpp/sca/modules/eval/environment.hpp | 49 | ||||
-rw-r--r-- | cpp/sca/modules/eval/eval-test.cpp | 13 | ||||
-rw-r--r-- | cpp/sca/modules/eval/eval.hpp | 56 | ||||
-rw-r--r-- | cpp/sca/modules/eval/primitive.hpp | 16 | ||||
-rw-r--r-- | cpp/sca/modules/http/Makefile.am | 6 | ||||
-rw-r--r-- | cpp/sca/modules/json/Makefile.am | 4 |
9 files changed, 92 insertions, 74 deletions
diff --git a/cpp/sca/modules/atom/Makefile.am b/cpp/sca/modules/atom/Makefile.am index 5373587c43..2e4eb4b89f 100644 --- a/cpp/sca/modules/atom/Makefile.am +++ b/cpp/sca/modules/atom/Makefile.am @@ -17,10 +17,10 @@ noinst_PROGRAMS = atom-test -INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} +INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} -I${APR_INCLUDE} atom_test_SOURCES = atom-test.cpp -atom_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 +atom_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${APR_LIB} -lapr-1 -laprutil-1 TESTS = atom-test diff --git a/cpp/sca/modules/eval/Makefile.am b/cpp/sca/modules/eval/Makefile.am index b9fa9f8f56..b6b85c6965 100644 --- a/cpp/sca/modules/eval/Makefile.am +++ b/cpp/sca/modules/eval/Makefile.am @@ -20,13 +20,13 @@ noinst_PROGRAMS = eval-test eval-shell datadir=$(prefix)/modules/eval nobase_data_DATA = *.xsd -INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} +INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} -I${APR_INCLUDE} eval_test_SOURCES = eval-test.cpp -eval_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 +eval_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${APR_LIB} -lapr-1 -laprutil-1 eval_shell_SOURCES = eval-shell.cpp -eval_shell_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 +eval_shell_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${APR_LIB} -lapr-1 -laprutil-1 TESTS = eval-test diff --git a/cpp/sca/modules/eval/driver.hpp b/cpp/sca/modules/eval/driver.hpp index 064213706c..f777973ebf 100644 --- a/cpp/sca/modules/eval/driver.hpp +++ b/cpp/sca/modules/eval/driver.hpp @@ -53,21 +53,23 @@ const bool userPrint(std::ostream& out, const value object) { return true; } -const value evalDriverLoop(std::istream& in, std::ostream& out, Env& globalEnv) { +const value evalDriverLoop(std::istream& in, std::ostream& out, Env& globalEnv, const gc_pool& pool) { promptForInput(out, evalInputPrompt); value input = read(in); if (isNil(input)) return input; - const value output = evalApply(input, globalEnv); + const value output = evalExpr(input, globalEnv, pool); announceOutput(out, evalOutputPrompt); userPrint(out, output); - return evalDriverLoop(in, out, globalEnv); + return evalDriverLoop(in, out, globalEnv, pool); } const bool evalDriverRun(std::istream& in, std::ostream& out) { + gc_pool pool; setupEvalOut(out); - Env globalEnv = setupEnvironment(); - evalDriverLoop(in, out, globalEnv); + Env globalEnv = setupEnvironment(pool); + evalDriverLoop(in, out, globalEnv, pool); + cleanupEnvironment(globalEnv); return true; } diff --git a/cpp/sca/modules/eval/environment.hpp b/cpp/sca/modules/eval/environment.hpp index e0da9096fe..90a1d88854 100644 --- a/cpp/sca/modules/eval/environment.hpp +++ b/cpp/sca/modules/eval/environment.hpp @@ -34,7 +34,7 @@ namespace tuscany { namespace eval { -typedef list<value> Frame; +typedef value Frame; typedef list<value> Env; const value trueSymbol("true"); @@ -63,7 +63,7 @@ const Env enclosingEnvironment(const Env& env) { return cdr(env); } -const value firstFrame(const Env& env) { +const gc_pool_ptr<Frame> firstFrame(const Env& env) { return car(env); } @@ -101,9 +101,10 @@ const Frame makeBinding(const Frame& frameSoFar, const list<value>& variables, c return makeBinding(newFrame, cdr(variables), cdr(values)); } -const Frame makeFrame(const list<value>& variables, const list<value> values) { - const Frame emptyFrame = cons(value(list<value>()), list<value>()); - return makeBinding(emptyFrame, variables, values); +const gc_pool_ptr<Frame> makeFrame(const list<value>& variables, const list<value> values, const gc_pool& pool) { + gc_pool_ptr<Frame> frame = gc_pool_new<Frame>(pool); + *frame = value(makeBinding(cons(value(list<value>()), list<value>()), variables, values)); + return frame; } const value definitionVariable(const value& exp) { @@ -130,40 +131,34 @@ const value assignmentValue(const value& exp) { return car(cdr(cdr((list<value> )exp))); } -const bool addBindingToFrame(const value& var, const value& val, Frame& frame) { - //frame = cons(value(cons(var, frameVariables(frame))), cons(val, frameValues(frame))); - setCar(frame, (value)cons(var, frameVariables(frame))); - setCdr(frame, cons(val, frameValues(frame))); - return true; +const Frame addBindingToFrame(const value& var, const value& val, const Frame& frame) { + return cons(value(cons(var, frameVariables(frame))), cons(val, frameValues(frame))); } const bool defineVariable(const value& var, const value& val, Env& env) { - Frame frame = firstFrame(env); - addBindingToFrame(var, val, frame); - setCar(env, value(frame)); + *firstFrame(env) = addBindingToFrame(var, val, *firstFrame(env)); return true; } -struct environmentReference { - const Env env; - environmentReference(const Env& env) : env(env) { - } - const Env& operator()() const { - return env; - } -}; - -const Env extendEnvironment(const list<value>& vars, const list<value>& vals, const Env& baseEnv) { - return cons(value(makeFrame(vars, vals)), lambda<list<value>()>(environmentReference(baseEnv))); +const Env extendEnvironment(const list<value>& vars, const list<value>& vals, const Env& baseEnv, const gc_pool& pool) { + return cons<value>(makeFrame(vars, vals, pool), baseEnv); } -const Env setupEnvironment() { - Env env = extendEnvironment(primitiveProcedureNames(), primitiveProcedureObjects(), theEmptyEnvironment()); +const Env setupEnvironment(const gc_pool& pool) { + Env env = extendEnvironment(primitiveProcedureNames(), primitiveProcedureObjects(), theEmptyEnvironment(), pool); defineVariable(trueSymbol, true, env); defineVariable(falseSymbol, false, env); return env; } +const bool cleanupEnvironment(Env& env) { + if (isNil(env)) + return true; + *firstFrame(env) = list<value>(); + Env enclosing = enclosingEnvironment(env); + return cleanupEnvironment(enclosing); +} + const value lookupEnvLoop(const value& var, const Env& env); const value lookupEnvScan(const value& var, const list<value>& vars, const list<value>& vals, const Env& env) { @@ -179,7 +174,7 @@ const value lookupEnvLoop(const value& var, const Env& env) { std::cout << "Unbound variable " << var << "\n"; return value(); } - return lookupEnvScan(var, frameVariables(firstFrame(env)), frameValues(firstFrame(env)), env); + return lookupEnvScan(var, frameVariables(*firstFrame(env)), frameValues(*firstFrame(env)), env); } const value lookupVariableValue(const value& var, const Env& env) { diff --git a/cpp/sca/modules/eval/eval-test.cpp b/cpp/sca/modules/eval/eval-test.cpp index 95a286ade0..584c8470b1 100644 --- a/cpp/sca/modules/eval/eval-test.cpp +++ b/cpp/sca/modules/eval/eval-test.cpp @@ -33,11 +33,13 @@ namespace tuscany { namespace eval { bool testEnv() { + gc_pool pool; Env globalEnv = list<value>(); - Env env = extendEnvironment(mklist<value>("a"), mklist<value>(1), globalEnv); + Env env = extendEnvironment(mklist<value>("a"), mklist<value>(1), globalEnv, pool); defineVariable("x", env, env); - //assert(lookupVariableValue(value("x"), env) == env); + assert(lookupVariableValue(value("x"), env) == env); assert(lookupVariableValue("a", env) == value(1)); + cleanupEnvironment(env); return true; } @@ -135,14 +137,15 @@ bool testEval() { assert(contains(evalOutput(testSchemeBegin), "testBegin1 ok")); assert(contains(evalOutput(testSchemeBegin), "testBegin2 ok")); assert(contains(evalOutput(testSchemeLambda), "testLambda ok")); - //assert(contains(evalOutput(testSchemeForward), "testForward ok")); + assert(contains(evalOutput(testSchemeForward), "testForward ok")); return true; } bool testEvalExpr() { + gc_pool pool; const value exp = mklist<value>("+", 2, 3); - Env env = setupEnvironment(); - const value r = evalApply(exp, env); + Env env = setupEnvironment(pool); + const value r = evalExpr(exp, env, pool); assert(r == value(5)); return true; } diff --git a/cpp/sca/modules/eval/eval.hpp b/cpp/sca/modules/eval/eval.hpp index 1496c3bd09..78051c5a2b 100644 --- a/cpp/sca/modules/eval/eval.hpp +++ b/cpp/sca/modules/eval/eval.hpp @@ -36,7 +36,7 @@ namespace tuscany { namespace eval { -const value evalApply(const value& exp, Env& env); +const value evalExpr(const value& exp, Env& env, const gc_pool& pool); const value compoundProcedureSymbol("compound-procedure"); const value procedureSymbol("procedure"); @@ -86,10 +86,10 @@ const list<value> operands(const value& exp) { return cdr((list<value> )exp); } -const list<value> listOfValues(const list<value> exps, Env& env) { +const list<value> listOfValues(const list<value> exps, Env& env, const gc_pool& pool) { if(isNil(exps)) return list<value> (); - return cons(evalApply(car(exps), env), listOfValues(cdr(exps), env)); + return cons(evalExpr(car(exps), env, pool), listOfValues(cdr(exps), env, pool)); } const value applyOperat(const value& exp) { @@ -132,19 +132,19 @@ const value makeBegin(const list<value> seq) { return cons(beginSymbol, seq); } -const value evalSequence(const list<value>& exps, Env& env) { +const value evalSequence(const list<value>& exps, Env& env, const gc_pool& pool) { if(isLastExp(exps)) - return evalApply(firstExp(exps), env); - evalApply(firstExp(exps), env); - return evalSequence(restExp(exps), env); + return evalExpr(firstExp(exps), env, pool); + evalExpr(firstExp(exps), env, pool); + return evalSequence(restExp(exps), env, pool); } -const value applyProcedure(const value& procedure, list<value>& arguments) { +const value applyProcedure(const value& procedure, list<value>& arguments, const gc_pool& pool) { if(isPrimitiveProcedure(procedure)) return applyPrimitiveProcedure(procedure, arguments); if(isCompoundProcedure(procedure)) { - Env env = extendEnvironment(procedureParameters(procedure), arguments, procedureEnvironment(procedure)); - return evalSequence(procedureBody(procedure), env); + Env env = extendEnvironment(procedureParameters(procedure), arguments, procedureEnvironment(procedure), pool); + return evalSequence(procedureBody(procedure), env, pool); } std::cout << "Unknown procedure type " << procedure << "\n"; return value(); @@ -218,46 +218,52 @@ value condToIf(const value& exp) { return expandClauses(condClauses(exp)); } -value evalIf(const value& exp, Env& env) { - if(isTrue(evalApply(ifPredicate(exp), env))) - return evalApply(ifConsequent(exp), env); - return evalApply(ifAlternative(exp), env); +value evalIf(const value& exp, Env& env, const gc_pool& pool) { + if(isTrue(evalExpr(ifPredicate(exp), env, pool))) + return evalExpr(ifConsequent(exp), env, pool); + return evalExpr(ifAlternative(exp), env, pool); } -const value evalDefinition(const value& exp, Env& env) { - defineVariable(definitionVariable(exp), evalApply(definitionValue(exp), env), env); +const value evalDefinition(const value& exp, Env& env, const gc_pool& pool) { + defineVariable(definitionVariable(exp), evalExpr(definitionValue(exp), env, pool), env); return definitionVariable(exp); } -const value evalApply(const value& exp, Env& env) { +const value evalExpr(const value& exp, Env& env, const gc_pool& pool) { if(isSelfEvaluating(exp)) return exp; if(isQuoted(exp)) return textOfQuotation(exp); if(isDefinition(exp)) - return evalDefinition(exp, env); + return evalDefinition(exp, env, pool); if(isIf(exp)) - return evalIf(exp, env); + return evalIf(exp, env, pool); if(isBegin(exp)) - return evalSequence(beginActions(exp), env); + return evalSequence(beginActions(exp), env, pool); if(isCond(exp)) - return evalApply(condToIf(exp), env); + return evalExpr(condToIf(exp), env, pool); if(isLambda(exp)) return makeProcedure(lambdaParameters(exp), lambdaBody(exp), env); if(isVariable(exp)) return lookupVariableValue(exp, env); if(isApply(exp)) { - list<value> applyOperandValues = evalApply(applyOperand(exp), env); - return applyProcedure(evalApply(applyOperat(exp), env), applyOperandValues); + list<value> applyOperandValues = evalExpr(applyOperand(exp), env, pool); + return applyProcedure(evalExpr(applyOperat(exp), env, pool), applyOperandValues, pool); } if(isApplication(exp)) { - list<value> operandValues = listOfValues(operands(exp), env); - return applyProcedure(evalApply(operat(exp), env), operandValues); + list<value> operandValues = listOfValues(operands(exp), env, pool); + return applyProcedure(evalExpr(operat(exp), env, pool), operandValues, pool); } std::cout << "Unknown expression type " << exp << "\n"; return value(); } +const list<value> quotedParameters(const list<value>& p) { + if (isNil(p)) + return p; + return cons<value>(mklist<value>(quoteSymbol, car(p)), quotedParameters(cdr(p))); +} + } } #endif /* tuscany_eval_eval_hpp */ diff --git a/cpp/sca/modules/eval/primitive.hpp b/cpp/sca/modules/eval/primitive.hpp index 4ca6ea900a..423e5af07b 100644 --- a/cpp/sca/modules/eval/primitive.hpp +++ b/cpp/sca/modules/eval/primitive.hpp @@ -26,6 +26,8 @@ * Script evaluator primitive functions. */ +#include <apr_general.h> +#include <apr_uuid.h> #include <iostream> #include "function.hpp" #include "list.hpp" @@ -104,6 +106,14 @@ const value valueError(list<value>& args) { return true; } +const value valueUuid(list<value>& args) { + apr_uuid_t uuid; + apr_uuid_get(&uuid); + char buf[APR_UUID_FORMATTED_LENGTH]; + apr_uuid_format(buf, &uuid); + return std::string(buf, APR_UUID_FORMATTED_LENGTH); +} + const value applyPrimitiveProcedure(const value& proc, list<value>& args) { const lambda<value(list<value>&)> func(cadr((list<value>)proc)); return func(args); @@ -120,9 +130,9 @@ const bool isSelfEvaluating(const value& exp) { return true; if(isString(exp)) return true; - if(isBoolean(exp)) + if(isBool(exp)) return true; - if(isCharacter(exp)) + if(isChar(exp)) return true; return false; } @@ -148,6 +158,7 @@ const list<value> primitiveProcedureNames() { l = cons<value>("/", l); l = cons<value>("equal?", l); l = cons<value>("display", l); + l = cons<value>("uuid", l); l = cons<value>(";", l); return l; } @@ -165,6 +176,7 @@ const list<value> primitiveProcedureObjects() { l = cons(primitiveProcedure(valueDiv), l); l = cons(primitiveProcedure(valueEqual), l); l = cons(primitiveProcedure(valueDisplay), l); + l = cons(primitiveProcedure(valueUuid), l); l = cons(primitiveProcedure(valueComment), l); return l; } diff --git a/cpp/sca/modules/http/Makefile.am b/cpp/sca/modules/http/Makefile.am index d34da0822f..6fe3b944d1 100644 --- a/cpp/sca/modules/http/Makefile.am +++ b/cpp/sca/modules/http/Makefile.am @@ -20,13 +20,13 @@ noinst_PROGRAMS = curl-test libdir=$(prefix)/lib lib_LTLIBRARIES = libmod_tuscany.la -INCLUDES = -I. -I$(top_builddir)/kernel -I${HTTPD_INCLUDE} -I${APR_INCLUDE} -I${LIBXML2_INCLUDE} -I${LIBMOZJS_INCLUDE} -I${CURL_INCLUDE} +INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} -I${HTTPD_INCLUDE} -I${APR_INCLUDE} -I${LIBMOZJS_INCLUDE} -I${CURL_INCLUDE} libmod_tuscany_la_SOURCES = mod.cpp -libmod_tuscany_la_LIBADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${LIBMOZJS_LIB} -lmozjs +libmod_tuscany_la_LIBADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${APR_LIB} -lapr-1 -laprutil-1 -L${LIBMOZJS_LIB} -lmozjs curl_test_SOURCES = curl-test.cpp -curl_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${CURL_LIB} -lcurl +curl_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${APR_LIB} -lapr-1 -laprutil-1 -L${CURL_LIB} -lcurl -L${LIBMOZJS_LIB} -lmozjs TESTS = httpd-test http-test diff --git a/cpp/sca/modules/json/Makefile.am b/cpp/sca/modules/json/Makefile.am index 059eac97a2..1c4222870c 100644 --- a/cpp/sca/modules/json/Makefile.am +++ b/cpp/sca/modules/json/Makefile.am @@ -17,10 +17,10 @@ noinst_PROGRAMS = json-test -INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} -I${LIBMOZJS_INCLUDE} +INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} -I${APR_INCLUDE} -I${LIBMOZJS_INCLUDE} json_test_SOURCES = json-test.cpp -json_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${LIBMOZJS_LIB} -lmozjs +json_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${APR_LIB} -lapr-1 -laprutil-1 -L${LIBMOZJS_LIB} -lmozjs TESTS = json-test |