diff options
Diffstat (limited to 'cpp/sca/modules/eval')
| -rw-r--r-- | cpp/sca/modules/eval/Makefile.am | 34 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/driver.hpp | 77 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/environment.hpp | 178 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/eval-shell.cpp | 35 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/eval-test.cpp | 240 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/eval.hpp | 290 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/io.hpp | 206 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/primitive.hpp | 197 | ||||
| -rw-r--r-- | cpp/sca/modules/eval/tuscany-sca-1.1-implementation-eval.xsd | 43 |
9 files changed, 0 insertions, 1300 deletions
diff --git a/cpp/sca/modules/eval/Makefile.am b/cpp/sca/modules/eval/Makefile.am deleted file mode 100644 index 68e01d42e2..0000000000 --- a/cpp/sca/modules/eval/Makefile.am +++ /dev/null @@ -1,34 +0,0 @@ -# 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/cpp/sca/modules/eval/driver.hpp b/cpp/sca/modules/eval/driver.hpp deleted file mode 100644 index 4c69ecb0a1..0000000000 --- a/cpp/sca/modules/eval/driver.hpp +++ /dev/null @@ -1,77 +0,0 @@ -/* - * 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 { -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<value>(compoundProcedureSymbol, procedureParameters(val), procedureBody(val), "<procedure-env>"), 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/cpp/sca/modules/eval/environment.hpp b/cpp/sca/modules/eval/environment.hpp deleted file mode 100644 index fa9667b1ba..0000000000 --- a/cpp/sca/modules/eval/environment.hpp +++ /dev/null @@ -1,178 +0,0 @@ -/* - * 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" -#include "primitive.hpp" - -namespace tuscany { -namespace eval { - -typedef value Frame; -typedef list<value> 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<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 gc_pool_ptr<Frame> 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 bool isDotVariable(const value& var) { - return var == dotSymbol; -} - -const Frame makeBinding(const Frame& frameSoFar, const list<value>& variables, const list<value> 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<value>(values)); - - if (isNil(values)) { - if (!isNil(variables)) - 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 = cons(value(vars), vals); - - return makeBinding(newFrame, cdr(variables), cdr(values)); -} - -const gc_pool_ptr<Frame> makeFrame(const list<value>& variables, const list<value> values, const gc_pool& pool) { - gc_pool_ptr<Frame> frame = gc_pool_new<Frame>(pool); - *frame = value(makeBinding(cons(value(list<value>()), list<value>()), variables, values)); - return frame; -} - -const value definitionVariable(const value& exp) { - 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 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<value>& vars, const list<value>& vals, const Env& baseEnv, const gc_pool& pool) { - return cons<value>(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<value>& vars, const list<value>& 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/cpp/sca/modules/eval/eval-shell.cpp b/cpp/sca/modules/eval/eval-shell.cpp deleted file mode 100644 index e1c90101da..0000000000 --- a/cpp/sca/modules/eval/eval-shell.cpp +++ /dev/null @@ -1,35 +0,0 @@ -/* - * 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 <assert.h> -#include <iostream> -#include <string> -#include <sstream> -#include "driver.hpp" - -int main() { - tuscany::eval::evalDriverRun(std::cin, std::cout); - return 0; -} diff --git a/cpp/sca/modules/eval/eval-test.cpp b/cpp/sca/modules/eval/eval-test.cpp deleted file mode 100644 index 984b17b26d..0000000000 --- a/cpp/sca/modules/eval/eval-test.cpp +++ /dev/null @@ -1,240 +0,0 @@ -/* - * 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 { -namespace eval { - -bool testEnv() { - gc_pool pool; - Env globalEnv = list<value>(); - Env env = extendEnvironment(mklist<value>("a"), mklist<value>(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<value>("abcd", "xyz")); - - std::istringstream is5("(abcd (xyz tuv))"); - assert(readValue(is5) == mklist<value>("abcd", mklist<value>("xyz", "tuv"))); - - return true; -} - -bool testWrite() { - const list<value> i = list<value>() - << (list<value>() << "item" << "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83b" - << (list<value>() << "item" - << (list<value>() << "name" << "Apple") - << (list<value>() << "price" << "$2.99"))) - << (list<value>() << "item" << "cart-53d67a61-aa5e-4e5e-8401-39edeba8b83c" - << (list<value>() << "item" - << (list<value>() << "name" << "Orange") - << (list<value>() << "price" << "$3.55"))); - const list<value> a = cons<value>("Feed", cons<value>("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<value>("+", 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<value>& args) { - const double x = car(args); - const double y = cadr(args); - return x * y; -} - -const std::string testReturnLambda( - "(define (testReturnLambda) * )"); - -const std::string testCallLambda( - "(define (testCallLambda l x y) (l x y))"); - -bool testEvalLambda() { - gc_pool pool; - Env env = setupEnvironment(pool); - - const value trl = mklist<value>("testReturnLambda"); - std::istringstream trlis(testReturnLambda); - const value trlv = evalScript(trl, trlis, env, pool); - - std::istringstream tclis(testCallLambda); - const value tcl = cons<value>("testCallLambda", quotedParameters(mklist<value>(trlv, 2, 3))); - const value tclv = evalScript(tcl, tclis, env, pool); - assert(tclv == value(6)); - - std::istringstream tcelis(testCallLambda); - const value tcel = cons<value>("testCallLambda", quotedParameters(mklist<value>(primitiveProcedure(mult), 3, 4))); - const value tcelv = evalScript(tcel, tcelis, env, pool); - assert(tcelv == value(12)); - return true; -} - -bool testEvalGC() { - resetLambdaCounters(); - resetListCounters(); - resetValueCounters(); - testEval(); - testEvalExpr(); - testEvalLambda(); - assert(countValues == 0); - assert(countLambdas == 0); - assert(countlists == 0); - //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/cpp/sca/modules/eval/eval.hpp b/cpp/sca/modules/eval/eval.hpp deleted file mode 100644 index 8c9ecfdecc..0000000000 --- a/cpp/sca/modules/eval/eval.hpp +++ /dev/null @@ -1,290 +0,0 @@ -/* - * 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 <string.h> -#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<value> beginActions(const value& exp) { - return cdr((list<value> )exp); -} - -const bool isLambdaExpr(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 mklist<value>(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<value> )exp); -} - -const list<value> operands(const value& exp) { - return cdr((list<value> )exp); -} - -const list<value> listOfValues(const list<value> exps, Env& env, const gc_pool& pool) { - if(isNil(exps)) - return list<value> (); - return cons(evalExpr(car(exps), env, pool), listOfValues(cdr(exps), env, pool)); -} - -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); -} - -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 isNil(cdr(seq)); -} - -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 cons(beginSymbol, seq); -} - -const value evalSequence(const list<value>& 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<value>& 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<value> exps) { - if(isNil(exps)) - return exps; - 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(!isNil(cdr(cdr(cdr((list<value> )exp))))) - return car(cdr(cdr(cdr((list<value> )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<value>& clauses) { - if(isNil(clauses)) - return false; - const value first = car(clauses); - const list<value> 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<value> applyOperandValues = evalExpr(applyOperand(exp), env, pool); - return applyProcedure(evalExpr(applyOperat(exp), env, pool), applyOperandValues, pool); - } - if(isApplication(exp)) { - list<value> operandValues = listOfValues(operands(exp), env, pool); - return applyProcedure(evalExpr(operat(exp), env, pool), operandValues, pool); - } - std::cout << "Unknown expression type " << exp << "\n"; - return value(); -} - -const list<value> quotedParameters(const list<value>& p) { - if (isNil(p)) - return p; - return cons<value>(mklist<value>(quoteSymbol, car(p)), quotedParameters(cdr(p))); -} - -/** - * Evaluate an expression against a script provided as a list of values. - */ -const value evalScriptLoop(const value& expr, const list<value>& script, eval::Env& globalEnv, const gc_pool& pool) { - if (isNil(script)) - return eval::evalExpr(expr, globalEnv, pool); - eval::evalExpr(car(script), globalEnv, pool); - return evalScriptLoop(expr, cdr(script), globalEnv, pool); -} - -const value evalScript(const value& expr, const value& script, Env& env, const gc_pool& pool) { - return evalScriptLoop(expr, script, env, pool); -} - -/** - * Evaluate an expression against a script provided as an input stream. - */ -const value evalScript(const value& expr, std::istream& is, Env& env, const gc_pool& pool) { - return evalScript(expr, readScript(is), env, pool); -} - -} -} -#endif /* tuscany_eval_eval_hpp */ diff --git a/cpp/sca/modules/eval/io.hpp b/cpp/sca/modules/eval/io.hpp deleted file mode 100644 index a898a11440..0000000000 --- a/cpp/sca/modules/eval/io.hpp +++ /dev/null @@ -1,206 +0,0 @@ -/* - * 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 <iostream> -#include <string> -#include <sstream> -#include <ctype.h> - -#include "list.hpp" -#include "value.hpp" -#include "primitive.hpp" - -namespace tuscany { -namespace eval { - -const value rightParenthesis(mklist<value>(")")); -const value leftParenthesis(mklist<value>("(")); -const value comment(mklist<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) || 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<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(isNil(l)) - 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 listToString(readIdentifierHelper(mklist(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 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 stringToNumber(listToString(readNumberHelper(mklist(chr), in))); -} - -const value readValue(std::istream& in) { - const value nextToken = readToken(in); - if(isLeftParenthesis(nextToken)) - return readList(list<value> (), 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<value>(); - return cons(val, (list<value>)readScript(in)); -} - -} -} -#endif /* tuscany_eval_io_hpp */ diff --git a/cpp/sca/modules/eval/primitive.hpp b/cpp/sca/modules/eval/primitive.hpp deleted file mode 100644 index bd36c0e226..0000000000 --- a/cpp/sca/modules/eval/primitive.hpp +++ /dev/null @@ -1,197 +0,0 @@ -/* - * 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 <apr_general.h> -#include <apr_uuid.h> -#include <iostream> -#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<value>& args) { - return car((list<value> )car(args)); -} - -const value cdrProc(const list<value>& args) { - return cdr((list<value> )car(args)); -} - -const value consProc(const list<value>& args) { - return cons(car(args), (list<value> )cadr(args)); -} - -const value listProc(const list<value>& args) { - return args; -} - -const value nulProc(const list<value>& args) { - return (bool)isNil(car(args)); -} - -const value equalProc(const list<value>& args) { - return (bool)(car(args) == cadr(args)); -} - -const value addProc(const list<value>& args) { - if (isNil(cdr(args))) - return (double)car(args); - return (double)car(args) + (double)cadr(args); -} - -const value subProc(const list<value>& args) { - if (isNil(cdr(args))) - return (double)0 - (double)car(args); - return (double)car(args) - (double)cadr(args); -} - -const value mulProc(const list<value>& args) { - return (double)car(args) * (double)cadr(args); -} - -const value divProc(const list<value>& args) { - return (double)car(args) / (double)cadr(args); -} - -const value displayProc(const list<value>& args) { - *displayOut << car(args); - (*displayOut).flush(); - return true; -} - -const value uuidProc(const list<value>& args) { - apr_uuid_t uuid; - apr_uuid_get(&uuid); - char buf[APR_UUID_FORMATTED_LENGTH]; - apr_uuid_format(buf, &uuid); - return std::string(buf, APR_UUID_FORMATTED_LENGTH); -} - -const value applyPrimitiveProcedure(const value& proc, list<value>& args, const gc_pool& pool) { - 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(isBool(exp)) - return true; - if(isChar(exp)) - return true; - if(isLambda(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 mklist<value>(primitiveSymbol, (lambda<value(list<value>&)>)f); -} - -const list<value> primitiveProcedureNames() { - list<value> l = mklist<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); - l = cons<value>("uuid", l); - return l; -} - -const list<value> primitiveProcedureObjects() { - list<value> 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<value> )exp)); -} - -const value makeLambda(const list<value>& parameters, const list<value>& body) { - return cons(lambdaSymbol, cons<value>(parameters, body)); -} - -} -} -#endif /* tuscany_eval_primitive_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 deleted file mode 100644 index bbf4935346..0000000000 --- a/cpp/sca/modules/eval/tuscany-sca-1.1-implementation-eval.xsd +++ /dev/null @@ -1,43 +0,0 @@ -<?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> |