diff options
Diffstat (limited to 'cpp')
-rw-r--r-- | cpp/sca/modules/Makefile.am | 19 | ||||
-rw-r--r-- | cpp/sca/modules/eval/Makefile.am | 32 | ||||
-rw-r--r-- | cpp/sca/modules/eval/driver.hpp | 76 | ||||
-rw-r--r-- | cpp/sca/modules/eval/environment.hpp | 152 | ||||
-rwxr-xr-x | cpp/sca/modules/eval/eval-test | bin | 0 -> 436085 bytes | |||
-rw-r--r-- | cpp/sca/modules/eval/eval-test.cpp | 173 | ||||
-rw-r--r-- | cpp/sca/modules/eval/eval.hpp | 383 | ||||
-rw-r--r-- | cpp/sca/modules/eval/primitive.hpp | 174 | ||||
-rw-r--r-- | cpp/sca/modules/eval/read.hpp | 182 | ||||
-rw-r--r-- | cpp/sca/modules/eval/tuscany-sca-1.1-implementation-eval.xsd | 43 |
10 files changed, 1234 insertions, 0 deletions
diff --git a/cpp/sca/modules/Makefile.am b/cpp/sca/modules/Makefile.am new file mode 100644 index 0000000000..cfc3245f7b --- /dev/null +++ b/cpp/sca/modules/Makefile.am @@ -0,0 +1,19 @@ +# 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. + +EVAL_MODULE = eval +SUBDIRS = ${EVAL_MODULE} diff --git a/cpp/sca/modules/eval/Makefile.am b/cpp/sca/modules/eval/Makefile.am new file mode 100644 index 0000000000..9b09d912d9 --- /dev/null +++ b/cpp/sca/modules/eval/Makefile.am @@ -0,0 +1,32 @@ +# 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. + +noinst_PROGRAMS = eval-test + +datadir=$(prefix)/modules/eval +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 new file mode 100644 index 0000000000..c1b2e1e96f --- /dev/null +++ b/cpp/sca/modules/eval/driver.hpp @@ -0,0 +1,76 @@ +/* + * 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$ */ + +#ifndef tuscany_eval_driver_hpp +#define tuscany_eval_driver_hpp + +/** + * Script evaluator main driver loop. + */ + +#include <string> +#include <iostream> +#include "eval.hpp" + +namespace tuscany +{ + +const std::string evalOutputPrompt(";;; Eval value: "); +const std::string evalInputPrompt(";;; Eval input: "); + +const bool promptForInput(std::ostream& out, const std::string str) { + out << "\n\n" << str << "\n"; + return true; +} + +const bool announceOutput(std::ostream& out, const std::string str) { + out << "\n" << str << "\n"; + return true; +} + +const bool userPrint(std::ostream& out, const value object) { + if(isCompoundProcedure(object)) + out << makeList(compoundProcedureSymbol, value(procedureParameters(object)), value(procedureBody(object)), value( + "<procedure-env>")); + out << object; + return true; +} + +const value evalDriverLoop(std::istream& in, std::ostream& out, Env& globalEnv) { + promptForInput(out, evalInputPrompt); + value input = read(in); + if (isNil(input)) + return input; + const value output = eval(input, globalEnv); + announceOutput(out, evalOutputPrompt); + userPrint(out, output); + return evalDriverLoop(in, out, globalEnv); +} + +const bool evalDriverRun(std::istream& in, std::ostream& out) { + setupEvalOut(out); + Env globalEnv = setupEnvironment(); + evalDriverLoop(in, out, globalEnv); + return true; +} + +} +#endif /* tuscany_eval_driver_hpp */ diff --git a/cpp/sca/modules/eval/environment.hpp b/cpp/sca/modules/eval/environment.hpp new file mode 100644 index 0000000000..4ee27df552 --- /dev/null +++ b/cpp/sca/modules/eval/environment.hpp @@ -0,0 +1,152 @@ +/* + * 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$ */ + +#ifndef tuscany_eval_environment_hpp +#define tuscany_eval_environment_hpp + +/** + * Script evaluator environment implementation. + */ + +#include <string> +#include "list.hpp" +#include "value.hpp" + +namespace tuscany +{ + +typedef value Frame; +typedef list<value> Env; + +const value trueSymbol = value("true"); +const value falseSymbol = value("false"); +const value defineSymbol = value("define"); +const value setSymbol = value("set!"); + +const Env theEmptyEnvironment() { + return list<value>(); +} + +const bool isDefinition(const value& exp) { + return isTaggedList(exp, defineSymbol); +} + +const bool isAssignment(const value& exp) { + return isTaggedList(exp, setSymbol); +} + +const bool isVariable(const value& exp) { + return isSymbol(exp); +} + +const Env enclosingEnvironment(const Env& env) { + return cdr(env); +} + +const value firstFrame(const Env& env) { + return car(env); +} + +list<value> frameVariables(const Frame& frame) { + return car((list<value> )frame); +} + +list<value> frameValues(const Frame& frame) { + return cdr((list<value> )frame); +} + +const Frame makeFrame(const list<value>& variables, const list<value> values) { + return value(cons((value)variables, values)); +} + +const value definitionVariable(const value& exp) { + const list<value> exps(exp); + if(isSymbol(car(cdr(exps)))) + return car(cdr(exps)); + const list<value> lexps(car(cdr(exps))); + return car(lexps); +} + +const value definitionValue(const value& exp) { + const list<value> exps(exp); + if(isSymbol(car(cdr(exps)))) + return car(cdr(cdr(exps))); + const list<value> lexps(car(cdr(exps))); + return makeLambda(cdr(lexps), cdr(cdr(exps))); +} + +const value assignmentVariable(const value& exp) { + return car(cdr((list<value> )exp)); +} + +const value assignmentValue(const value& exp) { + return car(cdr(cdr((list<value> )exp))); +} + +const Frame addBindingToFrame(const value& var, const value& val, const Frame& frame) { + return value(cons((value)cons(var, frameVariables(frame)), cons(val, frameValues(frame)))); +} + +const Env defineVariable(const value& var, const value& val, Env& env) { + return value(cons(addBindingToFrame(var, val, firstFrame(env)), cdr(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; +} + +const Env setupEnvironment() { + Env env = extendEnvironment(primitiveProcedureNames(), primitiveProcedureObjects(), theEmptyEnvironment()); + env = defineVariable(trueSymbol, value(true), env); + env = defineVariable(falseSymbol, value(false), env); + return env; +} + +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) { + if(vars == list<value> ()) + return lookupEnvLoop(var, enclosingEnvironment(env)); + if(var == car(vars)) + return car(vals); + return lookupEnvScan(var, cdr(vars), cdr(vals), env); +} + +const value lookupEnvLoop(const value& var, const Env& env) { + if(env == theEmptyEnvironment()) { + std::cout << "Unbound variable " << var << "\n"; + return value(); + } + return lookupEnvScan(var, frameVariables(firstFrame(env)), frameValues(firstFrame(env)), env); +} + +const value lookupVariableValue(const value& var, const Env& env) { + return lookupEnvLoop(var, env); +} + +} +#endif /* tuscany_eval_environment_hpp */ diff --git a/cpp/sca/modules/eval/eval-test b/cpp/sca/modules/eval/eval-test Binary files differnew file mode 100755 index 0000000000..9e9b36ddbb --- /dev/null +++ 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 new file mode 100644 index 0000000000..e75485a2d5 --- /dev/null +++ b/cpp/sca/modules/eval/eval-test.cpp @@ -0,0 +1,173 @@ +/* + * 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 script evaluator. + */ + +#include <assert.h> +#include <iostream> +#include <string> +#include <sstream> +#include "driver.hpp" + +namespace tuscany { + +bool testEnv() { + Env globalEnv = list<value>(); + Env env = extendEnvironment(makeList(value("a")), makeList(value(1)), globalEnv); + defineVariable(value("x"), value(env), env); + //assert(lookupVariableValue(value("x"), env) == env); + assert(lookupVariableValue(value("a"), env) == value(1)); + return true; +} + +bool testEnvGC() { + resetValueCounters(); + resetLambdaCounters(); + resetlistCounters(); + testEnv(); + assert(countValues == 0); + assert(countLambdas == 0); + assert(countlists == 0); + return true; +} + +bool testRead() { + std::istringstream is("abcd"); + assert(read(is) == value("abcd")); + + std::istringstream is2("123"); + assert(read(is2) == value(123)); + + std::istringstream is3("(abcd)"); + assert(read(is3) == value(makeList(value("abcd")))); + + std::istringstream is4("(abcd xyz)"); + assert(read(is4) == value(makeList(value("abcd"), value("xyz")))); + + std::istringstream is5("(abcd (xyz tuv))"); + assert(read(is5) == value(makeList(value("abcd"), value(makeList(value("xyz"), value("tuv")))))); + + return true; +} + +const std::string testSchemeNumber( + "(define (testNumber) (if (= 1 1) (display \"testNumber ok\") (error \"testNumber\"))) " + "(testNumber)"); + +const std::string testSchemeString( + "(define (testString) (if (= \"abc\" \"abc\") (display \"testString ok\") (error \"testString\"))) " + "(testString)"); + +const std::string testSchemeDefinition( + "(define a \"abc\") (define (testDefinition) (if (= a \"abc\") (display \"testDefinition ok\") (error \"testDefinition\"))) " + "(testDefinition)"); + +const std::string testSchemeIf( + "(define (testIf) (if (= \"abc\" \"abc\") (if (= \"xyz\" \"xyz\") (display \"testIf ok\") (error \"testNestedIf\")) (error \"testIf\"))) " + "(testIf)"); + +const std::string testSchemeCond( + "(define (testCond) (cond ((= \"abc\" \"abc\") (display \"testCond ok\")) (else (error \"testIf\"))))" + "(testCond)"); + +const std::string testSchemeBegin( + "(define (testBegin) " + "(begin " + "(define a \"abc\") " + "(if (= a \"abc\") (display \"testBegin1 ok\") (error \"testBegin\")) " + "(define x \"xyz\") " + "(if (= x \"xyz\") (display \"testBegin2 ok\") (error \"testBegin\")) " + ") " + ") " + "(testBegin)"); + +const std::string testSchemeLambda( + "(define sqrt (lambda (x) (* x x))) " + "(define (testLambda) (if (= 4 (sqrt 2)) (display \"testLambda ok\") (error \"testLambda\"))) " + "(testLambda)"); + +bool contains(const std::string& str, const std::string& pattern) { + return str.find(pattern) != str.npos; +} + +const std::string evalOutput(const std::string& scm) { + std::istringstream is(scm); + std::ostringstream os; + evalDriverRun(is, os); + return os.str(); +} + +bool testEval() { + assert(contains(evalOutput(testSchemeNumber), "testNumber ok")); + assert(contains(evalOutput(testSchemeString), "testString ok")); + assert(contains(evalOutput(testSchemeDefinition), "testDefinition ok")); + assert(contains(evalOutput(testSchemeIf), "testIf ok")); + assert(contains(evalOutput(testSchemeCond), "testCond ok")); + assert(contains(evalOutput(testSchemeBegin), "testBegin1 ok")); + assert(contains(evalOutput(testSchemeBegin), "testBegin2 ok")); + assert(contains(evalOutput(testSchemeLambda), "testLambda ok")); + return true; +} + +bool testEvalExpr() { + const value exp = value(makeList(value("+"), value(2), value(3))); + Env env = setupEnvironment(); + const value r = eval(exp, env); + assert(value(5) == r); + return true; +} + +bool testEvalGC() { + resetValueCounters(); + resetLambdaCounters(); + resetlistCounters(); + testEval(); + assert(countValues == 0); + assert(countLambdas == 0); + assert(countlists == 0); + return true; +} + +bool testEvalRun() { + evalDriverRun(std::cin, std::cout); + return true; +} + +} + +int main() { + std::cout << "Testing..." << std::endl; + + tuscany::testEnv(); + tuscany::testEnvGC(); + tuscany::testRead(); + tuscany::testEval(); + tuscany::testEvalExpr(); + tuscany::testEvalGC(); + + std::cout << "OK" << std::endl; + + tuscany::testEvalRun(); + + return 0; +} diff --git a/cpp/sca/modules/eval/eval.hpp b/cpp/sca/modules/eval/eval.hpp new file mode 100644 index 0000000000..23e9554aa8 --- /dev/null +++ b/cpp/sca/modules/eval/eval.hpp @@ -0,0 +1,383 @@ +/* + * 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$ */ + +#ifndef tuscany_eval_eval_hpp +#define tuscany_eval_eval_hpp + +/** + * Script evaluator core evaluation logic. + */ + +#include <string> +#include "list.hpp" +#include "value.hpp" +#include "primitive.hpp" +#include "read.hpp" +#include "environment.hpp" + +namespace tuscany +{ + +const value compoundProcedureSymbol("compound-procedure"); +const value procedureSymbol("procedure"); +const value beginSymbol("begin"); +const value condSymbol("cond"); +const value elseSymbol("else"); +const value ifSymbol("if"); + +const bool isBegin(const value& exp) { + return isTaggedList(exp, beginSymbol); +} + +const list<value> beginActions(const value& exp) { + return cdr((list<value> )exp); +} + +const bool isLambda(const value& exp) { + return isTaggedList(exp, lambdaSymbol); +} + +const list<value> lambdaParameters(const value& exp) { + return car(cdr((list<value> )exp)); +} + +static list<value> lambdaBody(const value& exp) { + return cdr(cdr((list<value> )exp)); +} + +const value makeProcedure(const list<value>& parameters, const value& body, const Env& env) { + return value(makeList(procedureSymbol, value(parameters), body, value(env))); +} + +const bool isApplication(const value& exp) { + return isList(exp); +} + +const value operat(const value& exp) { + return car((list<value> )exp); +} + +const list<value> operands(const value& exp) { + return cdr((list<value> )exp); +} + +const bool isCompoundProcedure(const value& procedure) { + return isTaggedList(procedure, procedureSymbol); +} + +const list<value> procedureParameters(const value& exp) { + return car(cdr((list<value> )exp)); +} + +const value procedureBody(const value& exp) { + return car(cdr(cdr((list<value> )exp))); +} + +const Env procedureEnvironment(const value& exp) { + return (Env)car(cdr(cdr(cdr((list<value> )exp)))); +} + +const bool isLastExp(const list<value>& seq) { + return cdr(seq) == list<value> (); +} + +const value firstExp(const list<value>& seq) { + return car(seq); +} + +const value makeBegin(const list<value> seq) { + return value(cons(beginSymbol, seq)); +} + +const value sequenceToExp(const list<value> exps) { + if(exps == list<value> ()) + return value(list<value>()); + if(isLastExp(exps)) + return firstExp(exps); + return makeBegin(exps); +} + +const list<value> condClauses(const value& exp) { + return cdr((list<value> )exp); +} + +const value condPredicate(const value& clause) { + return car((list<value> )clause); +} + +const list<value> condActions(const value& clause) { + return cdr((list<value> )clause); +} + +const value ifPredicate(const value& exp) { + return car(cdr((list<value> )exp)); +} + +const value ifConsequent(const value& exp) { + return car(cdr(cdr((list<value> )exp))); +} + +const value ifAlternative(const value& exp) { + if(cdr(cdr(cdr((list<value> )exp))) != list<value> ()) + return car(cdr(cdr(cdr((list<value> )exp)))); + return value(false); +} + +const bool isCond(const value& exp) { + return isTaggedList(exp, condSymbol); +} + +const bool isCondElseClause(const value& clause) { + return condPredicate(clause) == elseSymbol; +} + +const bool isIf(const value& exp) { + return isTaggedList(exp, ifSymbol); +} + +const value makeIf(value predicate, value consequent, value alternative) { + return value(makeList(ifSymbol, predicate, consequent, alternative)); +} + +const value expandClauses(const list<value>& clauses) { + if(clauses == list<value> ()) + return value(false); + const value first = car(clauses); + const list<value> rest = cdr(clauses); + if(isCondElseClause(first)) { + if(rest == list<value> ()) + return sequenceToExp(condActions(first)); + std::cout << "else clause isn't last " << clauses << "\n"; + return value(); + } + return makeIf(condPredicate(first), sequenceToExp(condActions(first)), expandClauses(rest)); +} + +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)))); +} + +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 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) { + if(isSelfEvaluating(exp)) + return analyzeSelfEvaluating(exp); + if(isQuoted(exp)) + return analyzeQuoted(exp); + if(isDefinition(exp)) + return analyzeDefinition(exp); + if(isIf(exp)) + return analyzeIf(exp); + if(isBegin(exp)) + return analyzeSequence(beginActions(exp)); + if(isCond(exp)) + return analyze(condToIf(exp)); + if(isLambda(exp)) + return analyzeLambda(exp); + if(isVariable(exp)) + return analyzeVariable(exp); + if(isApplication(exp)) + return analyzeApplication(exp); + std::cout << "Unknown expression type " << exp << "\n"; + return lambda<value(Env&)>(evalUndefinedLambda()); +} + + const value eval(const value& exp, Env& env) { + return analyze(exp)(env); +} + +} +#endif /* tuscany_eval_eval_hpp */ diff --git a/cpp/sca/modules/eval/primitive.hpp b/cpp/sca/modules/eval/primitive.hpp new file mode 100644 index 0000000000..881f669317 --- /dev/null +++ b/cpp/sca/modules/eval/primitive.hpp @@ -0,0 +1,174 @@ +/* + * 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$ */ + +#ifndef tuscany_eval_primitive_hpp +#define tuscany_eval_primitive_hpp + +/** + * Script evaluator primitive functions. + */ + +#include <iostream> +#include "function.hpp" +#include "list.hpp" +#include "value.hpp" + +namespace tuscany +{ + +const value primitiveSymbol("primitive"); +const value quoteSymbol("'"); +const value lambdaSymbol("lambda"); + +std::ostream* evalOut = &std::cout; + +const bool setupEvalOut(std::ostream& out) { + evalOut = &out; + return true; +} + +const value valueCar(list<value>& args) { + return car((list<value> )car(args)); +} + +const value valueCdr(list<value>& args) { + return value(cdr((list<value> )car(args))); +} + +const value valueCons(list<value>& args) { + return value(cons(car(args), (list<value> )cadr(args))); +} + +const value valueNul(list<value>& args) { + return value((bool)isNil(car(args))); +} + +const value valueEqual(list<value>& args) { + return value((bool)(car(args) == cadr(args))); +} + +const value valueAdd(list<value>& args) { + return value((double)car(args) + (double)cadr(args)); +} + +const value valueSub(list<value>& args) { + return value((double)car(args) - (double)cadr(args)); +} + +const value valueMul(list<value>& args) { + return value((double)car(args) * (double)cadr(args)); +} + +const value valueDiv(list<value>& args) { + return value((double)car(args) / (double)cadr(args)); +} + +const value valueDisplay(list<value>& args) { + *evalOut << car(args); + return value(true); +} + +const value valueError(list<value>& args) { + std::cerr << (std::string)car(args); + return value(true); +} + +const value applyPrimitiveProcedure(const value& proc, list<value>& args) { + const lambda<value(list<value>&)> func(cadr((list<value>)proc)); + return func(args); +} + +const bool isPrimitiveProcedure(const value& proc) { + return isTaggedList(proc, primitiveSymbol); +} + +const bool isSelfEvaluating(const value& exp) { + if(isNil(exp)) + return true; + if(isNumber(exp)) + return true; + if(isString(exp)) + return true; + if(isBoolean(exp)) + return true; + if(isCharacter(exp)) + return true; + return false; +} + +const value primitiveImplementation(const list<value>& proc) { + return car(cdr(proc)); +} + +template<typename F> const value primitiveProcedure(const F& f) { + return value(makeList(primitiveSymbol, value((lambda<value(list<value>&)>)f))); +} + +const list<value> primitiveProcedureNames() { + list<value> l = makeList(value("car")); + l = cons(value("cdr"), l); + l = cons(value("cons"), 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("display"), l); + return l; +} + +const list<value> primitiveProcedureObjects() { + list<value> l = makeList(primitiveProcedure(valueCar)); + l = cons(primitiveProcedure(valueCdr), l); + l = cons(primitiveProcedure(valueCons), 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(valueDisplay), l); + return l; +} + +const bool isFalse(const value& exp) { + return (bool)exp == false; +} + +const bool isTrue(const value& exp) { + return (bool)exp == true; +} + +const bool isQuoted(const value& exp) { + return isTaggedList(exp, quoteSymbol); +} + +const value textOfQuotation(const value& exp) { + return car(cdr((list<value> )exp)); +} + +const value makeLambda(const list<value>& parameters, const list<value>& body) { + return value(cons(lambdaSymbol, cons((value)parameters, body))); +} + +} +#endif /* tuscany_eval_primitive_hpp */ diff --git a/cpp/sca/modules/eval/read.hpp b/cpp/sca/modules/eval/read.hpp new file mode 100644 index 0000000000..8ede2189a6 --- /dev/null +++ b/cpp/sca/modules/eval/read.hpp @@ -0,0 +1,182 @@ +/* + * 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$ */ + +#ifndef tuscany_eval_read_hpp +#define tuscany_eval_read_hpp + +/** + * Script evaluator read functions. + */ + +#include <iostream> +#include <string> +#include <sstream> +#include <ctype.h> + +#include "list.hpp" +#include "value.hpp" +#include "primitive.hpp" + +namespace tuscany +{ + +const value rightParenthesis(makeList(value(")"))); +const value leftParenthesis(makeList(value("("))); + +const double stringToNumber(const std::string& str) { + double d; + std::istringstream is(str); + is >> d; + return d; +} + +const bool isWhitespace(const char ch) { + return ch != -1 && isspace(ch); +} + +const bool isIdentifierStart(const char ch) { + return ch != -1 && !isspace(ch) && !isdigit(ch); +} + +const bool isIdentifierPart(const char ch) { + return ch != -1 && !isspace(ch) && ch != '(' && ch != ')'; +} + +const bool isDigit(const char ch) { + return isdigit(ch); +} + +const bool isLeftParenthesis(const value& token) { + return leftParenthesis == token; +} + +const bool isRightParenthesis(const value& token) { + return rightParenthesis == token; +} + +const char readChar(std::istream& in) { + if(in.eof()) { + return -1; + } + char c = in.get(); + return c; +} + +const char peekChar(std::istream& in) { + if(in.eof()) + return -1; + char c = in.peek(); + return c; +} + +const bool isQuote(const value& token) { + return token == quoteSymbol; +} + +const value readQuoted(std::istream& in); +const value readIdentifier(const char chr, std::istream& in); +const value readString(const char chr, std::istream& in); +const value readNumber(const char chr, std::istream& in); +const value read(std::istream& in); + +const value readToken(std::istream& in) { + const char firstChar = readChar(in); + if(isWhitespace(firstChar)) + return readToken(in); + if(firstChar == '\'') + return readQuoted(in); + if(firstChar == '(') + return leftParenthesis; + if(firstChar == ')') + return rightParenthesis; + if(firstChar == '"') + return readString(firstChar, in); + if(isIdentifierStart(firstChar)) + return readIdentifier(firstChar, in); + if(isDigit(firstChar)) + return readNumber(firstChar, in); + if(firstChar == -1) + return value(); + std::cout << "Illegal lexical syntax '" << firstChar << "'" << "\n"; + return readToken(in); +} + +const value readQuoted(std::istream& in) { + return value(makeList(quoteSymbol, read(in))); +} + +const list<value> readList(const list<value>& listSoFar, std::istream& in) { + const value token = readToken(in); + if(isNil(token) || isRightParenthesis(token)) + return reverse(listSoFar); + if(isLeftParenthesis(token)) + return readList(cons(value(readList(list<value> (), in)), listSoFar), in); + return readList(cons(token, listSoFar), in); +} + +const std::string listToString(const list<char>& l) { + if(l == list<char> ()) + return ""; + return car(l) + listToString(cdr(l)); +} + +const list<char> readIdentifierHelper(const list<char>& listSoFar, std::istream& in) { + const char nextChar = peekChar(in); + if(isIdentifierPart(nextChar)) + return readIdentifierHelper(cons(readChar(in), listSoFar), in); + return reverse(listSoFar); +} + +const value readIdentifier(const char chr, std::istream& in) { + return value(listToString(readIdentifierHelper(makeList(chr), in)).c_str()); +} + +const list<char> readStringHelper(const list<char>& listSoFar, std::istream& in) { + const char nextChar = readChar(in); + if(nextChar != -1 && nextChar != '"') + return readStringHelper(cons(nextChar, listSoFar), in); + return reverse(listSoFar); +} + +const value readString(const char chr, std::istream& in) { + return value(listToString(readStringHelper(list<char>(), in))); +} + +const list<char> readNumberHelper(const list<char>& listSoFar, std::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, std::istream& in) { + return value(stringToNumber(listToString(readNumberHelper(makeList(chr), in)))); +} + +const value read(std::istream& in) { + const value nextToken = readToken(in); + if(isLeftParenthesis(nextToken)) + return value(readList(list<value> (), in)); + return nextToken; +} + +} +#endif /* tuscany_eval_read_hpp */ diff --git a/cpp/sca/modules/eval/tuscany-sca-1.1-implementation-eval.xsd b/cpp/sca/modules/eval/tuscany-sca-1.1-implementation-eval.xsd new file mode 100644 index 0000000000..bbf4935346 --- /dev/null +++ b/cpp/sca/modules/eval/tuscany-sca-1.1-implementation-eval.xsd @@ -0,0 +1,43 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!-- + * 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. +--> +<schema xmlns="http://www.w3.org/2001/XMLSchema" + targetNamespace="http://tuscany.apache.org/xmlns/sca/1.1" + xmlns:sca="http://docs.oasis-open.org/ns/opencsa/sca/200903" + xmlns:t="http://tuscany.apache.org/xmlns/sca/1.1" + elementFormDefault="qualified"> + + <import namespace="http://docs.oasis-open.org/ns/opencsa/sca/200903" schemaLocation="sca-1.1-cd04.xsd"/> + + <element name="implementation.eval" type="t:EvalImplementation" substitutionGroup="sca:implementation"/> + + <complexType name="EvalImplementation"> + <complexContent> + <extension base="sca:Implementation"> + <sequence> + <any namespace="##targetNamespace" processContents="lax" + minOccurs="0" maxOccurs="unbounded"/> + </sequence> + <attribute name="location" type="anyURI" use="required"/> + <anyAttribute namespace="##any" processContents="lax"/> + </extension> + </complexContent> + </complexType> + +</schema> |