From bd0fdbf902f8ca8e7e352582efe938e1d6743dd1 Mon Sep 17 00:00:00 2001 From: jsdelfino Date: Mon, 16 Nov 2009 06:57:41 +0000 Subject: Cleaning up SVN structure, moving sca trunk to sca-cpp/trunk. git-svn-id: http://svn.us.apache.org/repos/asf/tuscany@880633 13f79535-47bb-0310-9956-ffa450edef68 --- sca-cpp/trunk/modules/eval/Makefile.am | 34 +++ sca-cpp/trunk/modules/eval/driver.hpp | 77 ++++++ sca-cpp/trunk/modules/eval/environment.hpp | 178 +++++++++++++ sca-cpp/trunk/modules/eval/eval-shell.cpp | 35 +++ sca-cpp/trunk/modules/eval/eval-test.cpp | 240 +++++++++++++++++ sca-cpp/trunk/modules/eval/eval.hpp | 290 +++++++++++++++++++++ sca-cpp/trunk/modules/eval/io.hpp | 206 +++++++++++++++ sca-cpp/trunk/modules/eval/primitive.hpp | 197 ++++++++++++++ .../eval/tuscany-sca-1.1-implementation-eval.xsd | 43 +++ 9 files changed, 1300 insertions(+) create mode 100644 sca-cpp/trunk/modules/eval/Makefile.am create mode 100644 sca-cpp/trunk/modules/eval/driver.hpp create mode 100644 sca-cpp/trunk/modules/eval/environment.hpp create mode 100644 sca-cpp/trunk/modules/eval/eval-shell.cpp create mode 100644 sca-cpp/trunk/modules/eval/eval-test.cpp create mode 100644 sca-cpp/trunk/modules/eval/eval.hpp create mode 100644 sca-cpp/trunk/modules/eval/io.hpp create mode 100644 sca-cpp/trunk/modules/eval/primitive.hpp create mode 100644 sca-cpp/trunk/modules/eval/tuscany-sca-1.1-implementation-eval.xsd (limited to 'sca-cpp/trunk/modules/eval') diff --git a/sca-cpp/trunk/modules/eval/Makefile.am b/sca-cpp/trunk/modules/eval/Makefile.am new file mode 100644 index 0000000000..68e01d42e2 --- /dev/null +++ b/sca-cpp/trunk/modules/eval/Makefile.am @@ -0,0 +1,34 @@ +# 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 eval-shell + +datadir=$(prefix)/modules/eval +nobase_data_DATA = *.xsd + +nobase_include_HEADERS = *.hpp + +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 -L${APR_LIB} -lapr-1 -laprutil-1 + +eval_shell_SOURCES = eval-shell.cpp +eval_shell_LDADD = -lpthread -L${LIBXML2_LIB} -lxml2 -L${APR_LIB} -lapr-1 -laprutil-1 + +TESTS = eval-test + diff --git a/sca-cpp/trunk/modules/eval/driver.hpp b/sca-cpp/trunk/modules/eval/driver.hpp new file mode 100644 index 0000000000..4c69ecb0a1 --- /dev/null +++ b/sca-cpp/trunk/modules/eval/driver.hpp @@ -0,0 +1,77 @@ +/* + * 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 +#include +#include "eval.hpp" + +namespace tuscany { +namespace eval { + +const std::string evalOutputPrompt("; "); +const std::string evalInputPrompt("=> "); + +const bool promptForInput(const std::string str, std::ostream& out) { + out << "\n\n" << str; + return true; +} + +const bool announceOutput(const std::string str, std::ostream& out) { + out << "\n" << str; + return true; +} + +const bool userPrint(const value val, std::ostream& out) { + if(isCompoundProcedure(val)) + writeValue(mklist(compoundProcedureSymbol, procedureParameters(val), procedureBody(val), ""), out); + writeValue(val, out); + return true; +} + +const value evalDriverLoop(std::istream& in, std::ostream& out, Env& globalEnv, const gc_pool& pool) { + promptForInput(evalInputPrompt, out); + value input = readValue(in); + if (isNil(input)) + return input; + const value output = evalExpr(input, globalEnv, pool); + announceOutput(evalOutputPrompt, out); + userPrint(output, out); + return evalDriverLoop(in, out, globalEnv, pool); +} + +const bool evalDriverRun(std::istream& in, std::ostream& out) { + gc_pool pool; + setupDisplay(out); + Env globalEnv = setupEnvironment(pool); + evalDriverLoop(in, out, globalEnv, pool); + return true; +} + +} +} +#endif /* tuscany_eval_driver_hpp */ diff --git a/sca-cpp/trunk/modules/eval/environment.hpp b/sca-cpp/trunk/modules/eval/environment.hpp new file mode 100644 index 0000000000..fa9667b1ba --- /dev/null +++ b/sca-cpp/trunk/modules/eval/environment.hpp @@ -0,0 +1,178 @@ +/* + * 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 +#include "list.hpp" +#include "value.hpp" +#include "primitive.hpp" + +namespace tuscany { +namespace eval { + +typedef value Frame; +typedef list Env; + +const value trueSymbol("true"); +const value falseSymbol("false"); +const value defineSymbol("define"); +const value setSymbol("set!"); +const value dotSymbol("."); + +const Env theEmptyEnvironment() { + return list(); +} + +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 gc_pool_ptr firstFrame(const Env& env) { + return car(env); +} + +list frameVariables(const Frame& frame) { + return car((list )frame); +} + +list frameValues(const Frame& frame) { + return cdr((list )frame); +} + +const bool isDotVariable(const value& var) { + return var == dotSymbol; +} + +const Frame makeBinding(const Frame& frameSoFar, const list& variables, const list values) { + if (isNil(variables)) { + if (!isNil(values)) + std::cout << "Too many arguments supplied " << values << "\n"; + return frameSoFar; + } + if (isDotVariable(car(variables))) + return makeBinding(frameSoFar, cdr(variables), mklist(values)); + + if (isNil(values)) { + if (!isNil(variables)) + std::cout << "Too few arguments supplied " << variables << "\n"; + return frameSoFar; + } + + const list vars = cons(car(variables), frameVariables(frameSoFar)); + const list vals = cons(car(values), frameValues(frameSoFar)); + const Frame newFrame = cons(value(vars), vals); + + return makeBinding(newFrame, cdr(variables), cdr(values)); +} + +const gc_pool_ptr makeFrame(const list& variables, const list values, const gc_pool& pool) { + gc_pool_ptr frame = gc_pool_new(pool); + *frame = value(makeBinding(cons(value(list()), list()), variables, values)); + return frame; +} + +const value definitionVariable(const value& exp) { + const list exps(exp); + if(isSymbol(car(cdr(exps)))) + return car(cdr(exps)); + const list lexps(car(cdr(exps))); + return car(lexps); +} + +const value definitionValue(const value& exp) { + const list exps(exp); + if(isSymbol(car(cdr(exps)))) + return car(cdr(cdr(exps))); + const list lexps(car(cdr(exps))); + return makeLambda(cdr(lexps), cdr(cdr(exps))); +} + +const value assignmentVariable(const value& exp) { + return car(cdr((list )exp)); +} + +const value assignmentValue(const value& exp) { + return car(cdr(cdr((list )exp))); +} + +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) { + *firstFrame(env) = addBindingToFrame(var, val, *firstFrame(env)); + return true; +} + +const Env extendEnvironment(const list& vars, const list& vals, const Env& baseEnv, const gc_pool& pool) { + return cons(makeFrame(vars, vals, pool), baseEnv); +} + +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 value lookupEnvLoop(const value& var, const Env& env); + +const value lookupEnvScan(const value& var, const list& vars, const list& vals, const Env& env) { + if(isNil(vars)) + 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/sca-cpp/trunk/modules/eval/eval-shell.cpp b/sca-cpp/trunk/modules/eval/eval-shell.cpp new file mode 100644 index 0000000000..e1c90101da --- /dev/null +++ b/sca-cpp/trunk/modules/eval/eval-shell.cpp @@ -0,0 +1,35 @@ +/* + * 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$ */ + +/** + * Script evaluator shell, used for interactive testing of scripts. + */ + +#include +#include +#include +#include +#include "driver.hpp" + +int main() { + tuscany::eval::evalDriverRun(std::cin, std::cout); + return 0; +} diff --git a/sca-cpp/trunk/modules/eval/eval-test.cpp b/sca-cpp/trunk/modules/eval/eval-test.cpp new file mode 100644 index 0000000000..984b17b26d --- /dev/null +++ b/sca-cpp/trunk/modules/eval/eval-test.cpp @@ -0,0 +1,240 @@ +/* + * 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 +#include +#include +#include +#include "driver.hpp" + +namespace tuscany { +namespace eval { + +bool testEnv() { + gc_pool pool; + Env globalEnv = list(); + Env env = extendEnvironment(mklist("a"), mklist(1), globalEnv, pool); + defineVariable("x", env, env); + assert(lookupVariableValue(value("x"), env) == env); + assert(lookupVariableValue("a", env) == value(1)); + return true; +} + +bool testEnvGC() { + resetLambdaCounters(); + resetListCounters(); + resetValueCounters(); + testEnv(); + assert(countValues == 0); + assert(countLambdas == 0); + assert(countlists == 0); + //printLambdaCounters(); + //printListCounters(); + //printValueCounters(); + return true; +} + +bool testRead() { + std::istringstream is("abcd"); + assert(readValue(is) == "abcd"); + + std::istringstream is2("123"); + assert(readValue(is2) == value(123)); + + std::istringstream is3("(abcd)"); + assert(readValue(is3) == mklist(value("abcd"))); + + std::istringstream is4("(abcd xyz)"); + assert(readValue(is4) == mklist("abcd", "xyz")); + + std::istringstream is5("(abcd (xyz tuv))"); + assert(readValue(is5) == mklist("abcd", mklist("xyz", "tuv"))); + + return true; +} + +bool testWrite() { + const list i = list() + << (list() << "item" << "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83b" + << (list() << "item" + << (list() << "name" << "Apple") + << (list() << "price" << "$2.99"))) + << (list() << "item" << "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83c" + << (list() << "item" + << (list() << "name" << "Orange") + << (list() << "price" << "$3.55"))); + const list a = cons("Feed", cons("feed-1234", i)); + std::ostringstream os; + writeValue(a, os); + std::istringstream is(os.str()); + assert(readValue(is) == a); + 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)"); + +const std::string testSchemeForward( + "(define (testLambda) (if (= 4 (sqrt 2)) (display \"testForward ok\") (error \"testForward\"))) " + "(define sqrt (lambda (x) (* x x))) " + "(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")); + assert(contains(evalOutput(testSchemeForward), "testForward ok")); + return true; +} + +bool testEvalExpr() { + gc_pool pool; + const value exp = mklist("+", 2, 3); + Env env = setupEnvironment(pool); + const value r = evalExpr(exp, env, pool); + assert(r == value(5)); + return true; +} + +bool testEvalRun() { + evalDriverRun(std::cin, std::cout); + return true; +} + +const value mult(const list& 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("testReturnLambda"); + std::istringstream trlis(testReturnLambda); + const value trlv = evalScript(trl, trlis, env, pool); + + std::istringstream tclis(testCallLambda); + const value tcl = cons("testCallLambda", quotedParameters(mklist(trlv, 2, 3))); + const value tclv = evalScript(tcl, tclis, env, pool); + assert(tclv == value(6)); + + std::istringstream tcelis(testCallLambda); + const value tcel = cons("testCallLambda", quotedParameters(mklist(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); + //printLambdaCounters(); + //printListCounters(); + //printValueCounters(); + return true; +} + +} +} + +int main() { + std::cout << "Testing..." << std::endl; + + tuscany::eval::testEnv(); + tuscany::eval::testEnvGC(); + tuscany::eval::testRead(); + tuscany::eval::testWrite(); + tuscany::eval::testEval(); + tuscany::eval::testEvalExpr(); + tuscany::eval::testEvalLambda(); + tuscany::eval::testEvalGC(); + + std::cout << "OK" << std::endl; + return 0; +} diff --git a/sca-cpp/trunk/modules/eval/eval.hpp b/sca-cpp/trunk/modules/eval/eval.hpp new file mode 100644 index 0000000000..8c9ecfdecc --- /dev/null +++ b/sca-cpp/trunk/modules/eval/eval.hpp @@ -0,0 +1,290 @@ +/* + * 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 + +/** + * Core script evaluation logic. + */ + +#include +#include "list.hpp" +#include "value.hpp" +#include "primitive.hpp" +#include "io.hpp" +#include "environment.hpp" + +namespace tuscany { +namespace eval { + +const value evalExpr(const value& exp, Env& env, const gc_pool& pool); + +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"); +const value ifSymbol("if"); + +const bool isBegin(const value& exp) { + return isTaggedList(exp, beginSymbol); +} + +const list beginActions(const value& exp) { + return cdr((list )exp); +} + +const bool isLambdaExpr(const value& exp) { + return isTaggedList(exp, lambdaSymbol); +} + +const list lambdaParameters(const value& exp) { + return car(cdr((list )exp)); +} + +static list lambdaBody(const value& exp) { + return cdr(cdr((list )exp)); +} + +const value makeProcedure(const list& parameters, const value& body, const Env& env) { + return mklist(procedureSymbol, parameters, body, env); +} + +const bool isApply(const value& exp) { + return isTaggedList(exp, applySymbol); +} + +const bool isApplication(const value& exp) { + return isList(exp); +} + +const value operat(const value& exp) { + return car((list )exp); +} + +const list operands(const value& exp) { + return cdr((list )exp); +} + +const list listOfValues(const list exps, Env& env, const gc_pool& pool) { + if(isNil(exps)) + return list (); + return cons(evalExpr(car(exps), env, pool), listOfValues(cdr(exps), env, pool)); +} + +const value applyOperat(const value& exp) { + return cadr((list )exp); +} + +const value applyOperand(const value& exp) { + return caddr((list )exp); +} + +const bool isCompoundProcedure(const value& procedure) { + return isTaggedList(procedure, procedureSymbol); +} + +const list procedureParameters(const value& exp) { + return car(cdr((list )exp)); +} + +const value procedureBody(const value& exp) { + return car(cdr(cdr((list )exp))); +} + +const Env procedureEnvironment(const value& exp) { + return (Env)car(cdr(cdr(cdr((list )exp)))); +} + +const bool isLastExp(const list& seq) { + return isNil(cdr(seq)); +} + +const value firstExp(const list& seq) { + return car(seq); +} + +const list restExp(const list& seq) { + return cdr(seq); +} + +const value makeBegin(const list seq) { + return cons(beginSymbol, seq); +} + +const value evalSequence(const list& exps, Env& env, const gc_pool& pool) { + if(isLastExp(exps)) + return evalExpr(firstExp(exps), env, pool); + evalExpr(firstExp(exps), env, pool); + return evalSequence(restExp(exps), env, pool); +} + +const value applyProcedure(const value& procedure, list& arguments, const gc_pool& pool) { + if(isPrimitiveProcedure(procedure)) + return applyPrimitiveProcedure(procedure, arguments, pool); + if(isCompoundProcedure(procedure)) { + Env env = extendEnvironment(procedureParameters(procedure), arguments, procedureEnvironment(procedure), pool); + return evalSequence(procedureBody(procedure), env, pool); + } + std::cout << "Unknown procedure type " << procedure << "\n"; + return value(); +} + +const value sequenceToExp(const list exps) { + if(isNil(exps)) + return exps; + if(isLastExp(exps)) + return firstExp(exps); + return makeBegin(exps); +} + +const list condClauses(const value& exp) { + return cdr((list )exp); +} + +const value condPredicate(const value& clause) { + return car((list )clause); +} + +const list condActions(const value& clause) { + return cdr((list )clause); +} + +const value ifPredicate(const value& exp) { + return car(cdr((list )exp)); +} + +const value ifConsequent(const value& exp) { + return car(cdr(cdr((list )exp))); +} + +const value ifAlternative(const value& exp) { + if(!isNil(cdr(cdr(cdr((list )exp))))) + return car(cdr(cdr(cdr((list )exp)))); + return 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 mklist(ifSymbol, predicate, consequent, alternative); +} + +const value expandClauses(const list& clauses) { + if(isNil(clauses)) + return false; + const value first = car(clauses); + const list rest = cdr(clauses); + if(isCondElseClause(first)) { + if(isNil(rest)) + 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)); +} + +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, const gc_pool& pool) { + defineVariable(definitionVariable(exp), evalExpr(definitionValue(exp), env, pool), env); + return definitionVariable(exp); +} + +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, pool); + if(isIf(exp)) + return evalIf(exp, env, pool); + if(isBegin(exp)) + return evalSequence(beginActions(exp), env, pool); + if(isCond(exp)) + return evalExpr(condToIf(exp), env, pool); + if(isLambdaExpr(exp)) + return makeProcedure(lambdaParameters(exp), lambdaBody(exp), env); + if(isVariable(exp)) + return lookupVariableValue(exp, env); + if(isApply(exp)) { + list applyOperandValues = evalExpr(applyOperand(exp), env, pool); + return applyProcedure(evalExpr(applyOperat(exp), env, pool), applyOperandValues, pool); + } + if(isApplication(exp)) { + list 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 quotedParameters(const list& p) { + if (isNil(p)) + return p; + return cons(mklist(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& 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/sca-cpp/trunk/modules/eval/io.hpp b/sca-cpp/trunk/modules/eval/io.hpp new file mode 100644 index 0000000000..a898a11440 --- /dev/null +++ b/sca-cpp/trunk/modules/eval/io.hpp @@ -0,0 +1,206 @@ +/* + * 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_io_hpp +#define tuscany_eval_io_hpp + +/** + * Script evaluator IO functions. + */ + +#include +#include +#include +#include + +#include "list.hpp" +#include "value.hpp" +#include "primitive.hpp" + +namespace tuscany { +namespace eval { + +const value rightParenthesis(mklist(")")); +const value leftParenthesis(mklist("(")); +const value comment(mklist(";")); + +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) || 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 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); +const value readNumber(const char chr, std::istream& in); +const value readValue(std::istream& in); + +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 == '(') + 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 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)); +} + +const list readList(const list& 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 (), in)), listSoFar), in); + return readList(cons(token, listSoFar), in); +} + +const std::string listToString(const list& l) { + if(isNil(l)) + return ""; + return car(l) + listToString(cdr(l)); +} + +const list readIdentifierHelper(const list& 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 listToString(readIdentifierHelper(mklist(chr), in)).c_str(); +} + +const list readStringHelper(const list& 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 listToString(readStringHelper(list(), in)); +} + +const list readNumberHelper(const list& 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 stringToNumber(listToString(readNumberHelper(mklist(chr), in))); +} + +const value readValue(std::istream& in) { + const value nextToken = readToken(in); + if(isLeftParenthesis(nextToken)) + return readList(list (), in); + return nextToken; +} + +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(); + return cons(val, (list)readScript(in)); +} + +} +} +#endif /* tuscany_eval_io_hpp */ diff --git a/sca-cpp/trunk/modules/eval/primitive.hpp b/sca-cpp/trunk/modules/eval/primitive.hpp new file mode 100644 index 0000000000..bd36c0e226 --- /dev/null +++ b/sca-cpp/trunk/modules/eval/primitive.hpp @@ -0,0 +1,197 @@ +/* + * 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 +#include +#include +#include "function.hpp" +#include "list.hpp" +#include "value.hpp" + +namespace tuscany { +namespace eval { + +const value primitiveSymbol("primitive"); +const value quoteSymbol("'"); +const value lambdaSymbol("lambda"); + +std::ostream* displayOut = &std::cout; + +const bool setupDisplay(std::ostream& out) { + displayOut = &out; + return true; +} + +const value carProc(const list& args) { + return car((list )car(args)); +} + +const value cdrProc(const list& args) { + return cdr((list )car(args)); +} + +const value consProc(const list& args) { + return cons(car(args), (list )cadr(args)); +} + +const value listProc(const list& args) { + return args; +} + +const value nulProc(const list& args) { + return (bool)isNil(car(args)); +} + +const value equalProc(const list& args) { + return (bool)(car(args) == cadr(args)); +} + +const value addProc(const list& args) { + if (isNil(cdr(args))) + return (double)car(args); + return (double)car(args) + (double)cadr(args); +} + +const value subProc(const list& args) { + if (isNil(cdr(args))) + return (double)0 - (double)car(args); + return (double)car(args) - (double)cadr(args); +} + +const value mulProc(const list& args) { + return (double)car(args) * (double)cadr(args); +} + +const value divProc(const list& args) { + return (double)car(args) / (double)cadr(args); +} + +const value displayProc(const list& args) { + *displayOut << car(args); + (*displayOut).flush(); + return true; +} + +const value uuidProc(const list& 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& args, const gc_pool& pool) { + const lambda&)> func(cadr((list)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(isBool(exp)) + return true; + if(isChar(exp)) + return true; + if(isLambda(exp)) + return true; + return false; +} + +const value primitiveImplementation(const list& proc) { + return car(cdr(proc)); +} + +template const value primitiveProcedure(const F& f) { + return mklist(primitiveSymbol, (lambda&)>)f); +} + +const list primitiveProcedureNames() { + list l = mklist("car"); + l = cons("cdr", l); + l = cons("cons", l); + l = cons("list", l); + l = cons("nul", l); + l = cons("=", l); + l = cons("+", l); + l = cons("-", l); + l = cons("*", l); + l = cons("/", l); + l = cons("equal?", l); + l = cons("display", l); + l = cons("uuid", l); + return l; +} + +const list primitiveProcedureObjects() { + list l = mklist(primitiveProcedure(carProc)); + l = cons(primitiveProcedure(cdrProc), l); + l = cons(primitiveProcedure(consProc), l); + l = cons(primitiveProcedure(listProc), l); + l = cons(primitiveProcedure(nulProc), l); + l = cons(primitiveProcedure(equalProc), l); + l = cons(primitiveProcedure(addProc), l); + l = cons(primitiveProcedure(subProc), l); + l = cons(primitiveProcedure(mulProc), l); + l = cons(primitiveProcedure(divProc), l); + l = cons(primitiveProcedure(equalProc), l); + l = cons(primitiveProcedure(displayProc), l); + l = cons(primitiveProcedure(uuidProc), 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 )exp)); +} + +const value makeLambda(const list& parameters, const list& body) { + return cons(lambdaSymbol, cons(parameters, body)); +} + +} +} +#endif /* tuscany_eval_primitive_hpp */ diff --git a/sca-cpp/trunk/modules/eval/tuscany-sca-1.1-implementation-eval.xsd b/sca-cpp/trunk/modules/eval/tuscany-sca-1.1-implementation-eval.xsd new file mode 100644 index 0000000000..bbf4935346 --- /dev/null +++ b/sca-cpp/trunk/modules/eval/tuscany-sca-1.1-implementation-eval.xsd @@ -0,0 +1,43 @@ + + + + + + + + + + + + + + + + + + + + + -- cgit v1.2.3