diff options
Diffstat (limited to '')
-rw-r--r-- | cpp/sca/modules/eval/Makefile.am | 5 | ||||
-rw-r--r-- | cpp/sca/modules/eval/driver.hpp | 8 | ||||
-rw-r--r-- | cpp/sca/modules/eval/environment.hpp | 45 | ||||
-rwxr-xr-x | cpp/sca/modules/eval/eval-test | bin | 436085 -> 335904 bytes | |||
-rw-r--r-- | cpp/sca/modules/eval/eval-test.cpp | 14 | ||||
-rw-r--r-- | cpp/sca/modules/eval/eval.hpp | 261 | ||||
-rw-r--r-- | cpp/sca/modules/eval/primitive.hpp | 12 | ||||
-rw-r--r-- | cpp/sca/modules/eval/read.hpp | 2 |
8 files changed, 134 insertions, 213 deletions
diff --git a/cpp/sca/modules/eval/Makefile.am b/cpp/sca/modules/eval/Makefile.am index 9b09d912d9..e1add383f4 100644 --- a/cpp/sca/modules/eval/Makefile.am +++ b/cpp/sca/modules/eval/Makefile.am @@ -22,11 +22,6 @@ nobase_data_DATA = *.xsd INCLUDES = -I. -I$(top_builddir)/kernel -I${LIBXML2_INCLUDE} -#libdir=$(prefix)/modules/eval/lib -#lib_LTLIBRARIES = libtuscany_eval.la -#libtuscany_eval_la_SOURCES = eval.cpp -#libtuscany_eval_la_LIBADD = -L${TUSCANY_SCACPP}/lib -ltuscany_sca -lpthread - eval_test_SOURCES = eval-test.cpp eval_test_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 diff --git a/cpp/sca/modules/eval/driver.hpp b/cpp/sca/modules/eval/driver.hpp index c1b2e1e96f..582f4f1b08 100644 --- a/cpp/sca/modules/eval/driver.hpp +++ b/cpp/sca/modules/eval/driver.hpp @@ -33,16 +33,16 @@ namespace tuscany { -const std::string evalOutputPrompt(";;; Eval value: "); -const std::string evalInputPrompt(";;; Eval input: "); +const std::string evalOutputPrompt("; "); +const std::string evalInputPrompt("=> "); const bool promptForInput(std::ostream& out, const std::string str) { - out << "\n\n" << str << "\n"; + out << "\n\n" << str; return true; } const bool announceOutput(std::ostream& out, const std::string str) { - out << "\n" << str << "\n"; + out << "\n" << str; return true; } diff --git a/cpp/sca/modules/eval/environment.hpp b/cpp/sca/modules/eval/environment.hpp index 4ee27df552..46c1716cd8 100644 --- a/cpp/sca/modules/eval/environment.hpp +++ b/cpp/sca/modules/eval/environment.hpp @@ -29,6 +29,7 @@ #include <string> #include "list.hpp" #include "value.hpp" +#include "primitive.hpp" namespace tuscany { @@ -40,6 +41,7 @@ const value trueSymbol = value("true"); const value falseSymbol = value("false"); const value defineSymbol = value("define"); const value setSymbol = value("set!"); +const value dotSymbol = value("."); const Env theEmptyEnvironment() { return list<value>(); @@ -73,8 +75,35 @@ list<value> frameValues(const Frame& frame) { return cdr((list<value> )frame); } +const bool isDotVariable(const value& var) { + return var == dotSymbol; +} + +const Frame makeBinding(const Frame& frameSoFar, const list<value>& variables, const list<value> values) { + if (variables == list<value>()) { + if (values != list<value>()) + std::cout << "Too many arguments supplied " << values << "\n"; + return frameSoFar; + } + if (isDotVariable(car(variables))) + return makeBinding(frameSoFar, cdr(variables), makeList(value(values))); + + if (values == list<value>()) { + if (variables != list<value>()) + std::cout << "Too few arguments supplied " << variables << "\n"; + return frameSoFar; + } + + const list<value> vars = cons(car(variables), frameVariables(frameSoFar)); + const list<value> vals = cons(car(values), frameValues(frameSoFar)); + const Frame newFrame = value(cons(value(vars), vals)); + + return makeBinding(newFrame, cdr(variables), cdr(values)); +} + const Frame makeFrame(const list<value>& variables, const list<value> values) { - return value(cons((value)variables, values)); + const Frame emptyFrame = value(cons((value)list<value>(), list<value>())); + return makeBinding(emptyFrame, variables, values); } const value definitionVariable(const value& exp) { @@ -110,13 +139,13 @@ const Env defineVariable(const value& var, const value& val, Env& env) { } const Env extendEnvironment(const list<value>& vars, const list<value>& vals, const Env& baseEnv) { - if(length(vars) == length(vals)) - return cons(makeFrame(vars, vals), baseEnv); - else if(length(vars) < length(vals)) - std::cout << "Too many arguments supplied " << vars << " " << vals << "\n"; - else - std::cout << "Too few arguments supplied " << vars << " " << vals << "\n"; - return baseEnv; +// if(length(vars) == length(vals)) +// else if(length(vars) < length(vals)) +// std::cout << "Too many arguments supplied " << vars << " " << vals << "\n"; +// else +// std::cout << "Too few arguments supplied " << vars << " " << vals << "\n"; +// return baseEnv; + return cons(makeFrame(vars, vals), baseEnv); } const Env setupEnvironment() { diff --git a/cpp/sca/modules/eval/eval-test b/cpp/sca/modules/eval/eval-test Binary files differindex 9e9b36ddbb..ff394153d1 100755 --- a/cpp/sca/modules/eval/eval-test +++ b/cpp/sca/modules/eval/eval-test diff --git a/cpp/sca/modules/eval/eval-test.cpp b/cpp/sca/modules/eval/eval-test.cpp index e75485a2d5..c8c86a1666 100644 --- a/cpp/sca/modules/eval/eval-test.cpp +++ b/cpp/sca/modules/eval/eval-test.cpp @@ -41,13 +41,16 @@ bool testEnv() { } bool testEnvGC() { - resetValueCounters(); resetLambdaCounters(); - resetlistCounters(); + resetListCounters(); + resetValueCounters(); testEnv(); assert(countValues == 0); assert(countLambdas == 0); assert(countlists == 0); + printLambdaCounters(); + printListCounters(); + printValueCounters(); return true; } @@ -138,13 +141,16 @@ bool testEvalExpr() { } bool testEvalGC() { - resetValueCounters(); resetLambdaCounters(); - resetlistCounters(); + resetListCounters(); + resetValueCounters(); testEval(); assert(countValues == 0); assert(countLambdas == 0); assert(countlists == 0); + printLambdaCounters(); + printListCounters(); + printValueCounters(); return true; } diff --git a/cpp/sca/modules/eval/eval.hpp b/cpp/sca/modules/eval/eval.hpp index 23e9554aa8..28e1d01ffc 100644 --- a/cpp/sca/modules/eval/eval.hpp +++ b/cpp/sca/modules/eval/eval.hpp @@ -23,10 +23,10 @@ #define tuscany_eval_eval_hpp /** - * Script evaluator core evaluation logic. + * Core script evaluation logic. */ -#include <string> +#include <string.h> #include "list.hpp" #include "value.hpp" #include "primitive.hpp" @@ -36,8 +36,11 @@ namespace tuscany { +const value eval(const value& exp, Env& env); + const value compoundProcedureSymbol("compound-procedure"); const value procedureSymbol("procedure"); +const value applySymbol("apply"); const value beginSymbol("begin"); const value condSymbol("cond"); const value elseSymbol("else"); @@ -67,6 +70,10 @@ const value makeProcedure(const list<value>& parameters, const value& body, cons return value(makeList(procedureSymbol, value(parameters), body, value(env))); } +const bool isApply(const value& exp) { + return isTaggedList(exp, applySymbol); +} + const bool isApplication(const value& exp) { return isList(exp); } @@ -79,6 +86,20 @@ const list<value> operands(const value& exp) { return cdr((list<value> )exp); } +const list<value> listOfValues(const list<value> exps, Env& env) { + if(exps == list<value> ()) + return list<value> (); + return cons(eval(car(exps), env), listOfValues(cdr(exps), env)); +} + +const value applyOperat(const value& exp) { + return cadr((list<value> )exp); +} + +const value applyOperand(const value& exp) { + return caddr((list<value> )exp); +} + const bool isCompoundProcedure(const value& procedure) { return isTaggedList(procedure, procedureSymbol); } @@ -103,10 +124,32 @@ const value firstExp(const list<value>& seq) { return car(seq); } +const list<value> restExp(const list<value>& seq) { + return cdr(seq); +} + const value makeBegin(const list<value> seq) { return value(cons(beginSymbol, seq)); } +const value evalSequence(const list<value>& exps, Env& env) { + if(isLastExp(exps)) + return eval(firstExp(exps), env); + eval(firstExp(exps), env); + return evalSequence(restExp(exps), env); +} + +const value applyProcedure(const value& procedure, list<value>& arguments) { + if(isPrimitiveProcedure(procedure)) + return applyPrimitiveProcedure(procedure, arguments); + if(isCompoundProcedure(procedure)) { + Env env = extendEnvironment(procedureParameters(procedure), arguments, procedureEnvironment(procedure)); + return evalSequence(procedureBody(procedure), env); + } + std::cout << "Unknown procedure type " << procedure << "\n"; + return value(); +} + const value sequenceToExp(const list<value> exps) { if(exps == list<value> ()) return value(list<value>()); @@ -175,208 +218,44 @@ value condToIf(const value& exp) { return expandClauses(condClauses(exp)); } -const lambda<value(Env&)> analyze(const value exp); - -struct evalUndefinedLambda { - evalUndefinedLambda() { - } - - const value operator()(Env& env) const { - return value(); - } -}; - -struct evalSelfEvaluatingLambda { - const value exp; - evalSelfEvaluatingLambda(const value& exp) : exp(exp) { - } - const value operator()(Env& env) const { - return exp; - } -}; - -const lambda<value(Env&)> analyzeSelfEvaluating(value exp) { - return lambda<value(Env&)>(evalSelfEvaluatingLambda(exp)); -} - -struct evalQuotedLambda { - const value qval; - evalQuotedLambda(const value& qval) : qval(qval) { - } - const value operator()(Env& env) const { - return qval; - } -}; - -const lambda<value(Env&)> analyzeQuoted(const value& exp) { - return lambda<value(Env&)>(evalQuotedLambda(textOfQuotation(exp))); -} - -struct evalVariableLambda { - const value var; - evalVariableLambda(const value& var) : var(var) { - } - const value operator()(Env& env) const { - return lookupVariableValue(var, env); - } -}; - -const lambda<value(Env&)> analyzeVariable(const value& exp) { - return lambda<value(Env&)>(evalVariableLambda(exp)); -} - -struct evalDefinitionLambda { - const value var; - const lambda<value(Env&)> vproc; - evalDefinitionLambda(const value& var, const lambda<value(Env&)>& vproc) : var(var), vproc(vproc) { - } - const value operator()(Env& env) const { - env = defineVariable(var, vproc(env), env); - return var; - } -}; - -const lambda<value(Env&)> analyzeDefinition(const value& exp) { - return lambda<value(Env&)>(evalDefinitionLambda(definitionVariable(exp), analyze(definitionValue(exp)))); +value evalIf(const value& exp, Env& env) { + if(isTrue(eval(ifPredicate(exp), env))) + return eval(ifConsequent(exp), env); + return eval(ifAlternative(exp), env); } -struct evalIfLambda { - const lambda<value(Env&)> pproc; - const lambda<value(Env&)> cproc; - const lambda<value(Env&)> aproc; - evalIfLambda(const lambda<value(Env&)> pproc, const lambda<value(Env&)>& cproc, const lambda<value(Env&)>& aproc) : - pproc(pproc), cproc(cproc), aproc(aproc) { - } - const value operator()(Env& env) const { - if(pproc(env)) - return cproc(env); - return aproc(env); - } -}; - -const lambda<value(Env&)> analyzeIf(const value& exp) { - const lambda<value(Env&)> pproc = analyze(ifPredicate(exp)); - const lambda<value(Env&)> cproc = analyze(ifConsequent(exp)); - const lambda<value(Env&)> aproc = analyze(ifAlternative(exp)); - return lambda<value(Env&)>(evalIfLambda(pproc, cproc, aproc)); -} - -struct evalSequenceLambda { - const lambda<value(Env&)> proc1; - const lambda<value(Env&)> proc2; - evalSequenceLambda(const lambda<value(Env&)>& proc1, const lambda<value(Env&)>& proc2) : - proc1(proc1), proc2(proc2) { - } - const value operator()(Env& env) const { - proc1(env); - return proc2(env); - } -}; - -const lambda<value(Env&)> analyzeSequenceSequentially(const lambda<value(Env&)>& proc1, const lambda<value(Env&)>& proc2) { - return lambda<value(Env&)>(evalSequenceLambda(proc1, proc2)); +const value evalDefinition(const value& exp, Env& env) { + env = defineVariable(definitionVariable(exp), eval(definitionValue(exp), env), env); + return definitionVariable(exp); } -const lambda<value(Env&)> analyzeSequenceLoop(const lambda<value(Env&)>& firstProc, const list<lambda<value(Env&)> >& restProcs) { - if(restProcs == list<lambda<value(Env&)> >()) - return firstProc; - return analyzeSequenceLoop(analyzeSequenceSequentially(firstProc, car(restProcs)), cdr(restProcs)); -} - -const lambda<value(Env&)> analyzeSequence(const list<value>& exps) { - lambda<lambda<value(Env&)>(value exp)> a(analyze); - const list<lambda<value(Env&)> > procs = map(a, exps); - if(procs == list<lambda<value(Env&)> >()) { - std::cout << "Empty sequence" << "\n"; - return lambda<value(Env&)>(evalUndefinedLambda()); - } - return analyzeSequenceLoop(car(procs), cdr(procs)); -} - -struct lambdaLambda { - const list<value> vars; - const lambda<value(Env&)> bproc; - lambdaLambda(const list<value> vars, const lambda<value(Env&)>& bproc) - : vars(vars), bproc(bproc) { - } - - const value operator()(Env& env) const { - return makeProcedure(vars, value(bproc), env); - } -}; - -const lambda<value(Env&)> analyzeLambda(const value& exp) { - const list<value> vars = lambdaParameters(exp); - const lambda<value(Env&)> bproc = analyzeSequence(lambdaBody(exp)); - return lambda<value(Env&)>(lambdaLambda(vars, bproc)); -} - -const value executeApplication(const value& proc, const list<value>& args) { - if(isPrimitiveProcedure(proc)) { - list<value> ncargs = args; - return applyPrimitiveProcedure(proc, ncargs); - } - if(isCompoundProcedure(proc)) { - lambda<value(Env&) > bproc(procedureBody(proc)); - Env env = extendEnvironment(procedureParameters(proc), args, procedureEnvironment(proc)); - return bproc(env); - } - std::cout << "Unknown procedure type " << proc << "\n"; - return value(); -} - -struct evalApplicationArgLambda { - Env& env; - evalApplicationArgLambda(Env& env) : env(env) { - } - const value operator()(const lambda<value(Env&)>& aproc) const { - return aproc(env); - } -}; - -struct evalApplicationLambda { - const lambda<value(Env&)> fproc; - const list<lambda<value(Env&)> > aprocs; - evalApplicationLambda(const lambda<value(Env&)>& fproc, const list<lambda<value(Env&)> >& aprocs) : - fproc(fproc), aprocs(aprocs) { - } - const value operator()(Env& env) const { - return executeApplication(fproc(env), map(lambda<value(lambda<value(Env&)>)>(evalApplicationArgLambda(env)), aprocs)); - } -}; - -const lambda<value(Env&)> analyzeApplication(const value& exp) { - const lambda<value(Env&)> fproc = analyze(operat(exp)); - lambda<lambda<value(Env&)>(value exp)> a(analyze); - const list<lambda<value(Env&)> > aprocs = map(a, operands(exp)); - return lambda<value(Env&)>(evalApplicationLambda(fproc, aprocs)); -} - -const lambda<value(Env&)> analyze(const value exp) { +const value eval(const value& exp, Env& env) { if(isSelfEvaluating(exp)) - return analyzeSelfEvaluating(exp); + return exp; if(isQuoted(exp)) - return analyzeQuoted(exp); + return textOfQuotation(exp); if(isDefinition(exp)) - return analyzeDefinition(exp); + return evalDefinition(exp, env); if(isIf(exp)) - return analyzeIf(exp); + return evalIf(exp, env); if(isBegin(exp)) - return analyzeSequence(beginActions(exp)); + return evalSequence(beginActions(exp), env); if(isCond(exp)) - return analyze(condToIf(exp)); + return eval(condToIf(exp), env); if(isLambda(exp)) - return analyzeLambda(exp); + return makeProcedure(lambdaParameters(exp), value(lambdaBody(exp)), env); if(isVariable(exp)) - return analyzeVariable(exp); - if(isApplication(exp)) - return analyzeApplication(exp); + return lookupVariableValue(exp, env); + if(isApply(exp)) { + list<value> applyOperandValues = eval(applyOperand(exp), env); + return applyProcedure(eval(applyOperat(exp), env), applyOperandValues); + } + if(isApplication(exp)) { + list<value> operandValues = listOfValues(operands(exp), env); + return applyProcedure(eval(operat(exp), env), operandValues); + } std::cout << "Unknown expression type " << exp << "\n"; - return lambda<value(Env&)>(evalUndefinedLambda()); -} - - const value eval(const value& exp, Env& env) { - return analyze(exp)(env); + return value(); } } diff --git a/cpp/sca/modules/eval/primitive.hpp b/cpp/sca/modules/eval/primitive.hpp index 881f669317..04e26178f4 100644 --- a/cpp/sca/modules/eval/primitive.hpp +++ b/cpp/sca/modules/eval/primitive.hpp @@ -57,6 +57,10 @@ const value valueCons(list<value>& args) { return value(cons(car(args), (list<value> )cadr(args))); } +const value valueList(list<value>& args) { + return value(args); +} + const value valueNul(list<value>& args) { return value((bool)isNil(car(args))); } @@ -66,10 +70,14 @@ const value valueEqual(list<value>& args) { } const value valueAdd(list<value>& args) { + if (cdr(args) == list<value>()) + return value((double)car(args)); return value((double)car(args) + (double)cadr(args)); } const value valueSub(list<value>& args) { + if (cdr(args) == list<value>()) + return value(0 - (double)car(args)); return value((double)car(args) - (double)cadr(args)); } @@ -126,12 +134,14 @@ const list<value> primitiveProcedureNames() { list<value> l = makeList(value("car")); l = cons(value("cdr"), l); l = cons(value("cons"), l); + l = cons(value("list"), l); l = cons(value("nul"), l); l = cons(value("="), l); l = cons(value("+"), l); l = cons(value("-"), l); l = cons(value("*"), l); l = cons(value("/"), l); + l = cons(value("equal?"), l); l = cons(value("display"), l); return l; } @@ -140,12 +150,14 @@ const list<value> primitiveProcedureObjects() { list<value> l = makeList(primitiveProcedure(valueCar)); l = cons(primitiveProcedure(valueCdr), l); l = cons(primitiveProcedure(valueCons), l); + l = cons(primitiveProcedure(valueList), l); l = cons(primitiveProcedure(valueNul), l); l = cons(primitiveProcedure(valueEqual), l); l = cons(primitiveProcedure(valueAdd), l); l = cons(primitiveProcedure(valueSub), l); l = cons(primitiveProcedure(valueMul), l); l = cons(primitiveProcedure(valueDiv), l); + l = cons(primitiveProcedure(valueEqual), l); l = cons(primitiveProcedure(valueDisplay), l); return l; } diff --git a/cpp/sca/modules/eval/read.hpp b/cpp/sca/modules/eval/read.hpp index 8ede2189a6..cd9068c017 100644 --- a/cpp/sca/modules/eval/read.hpp +++ b/cpp/sca/modules/eval/read.hpp @@ -61,7 +61,7 @@ const bool isIdentifierPart(const char ch) { } const bool isDigit(const char ch) { - return isdigit(ch); + return isdigit(ch) || ch == '.'; } const bool isLeftParenthesis(const value& token) { |