diff options
Diffstat (limited to 'sca-cpp/branches/lightweight-sca/modules/scheme')
14 files changed, 1694 insertions, 0 deletions
diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/Makefile.am b/sca-cpp/branches/lightweight-sca/modules/scheme/Makefile.am new file mode 100644 index 0000000000..130fe14303 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/Makefile.am @@ -0,0 +1,47 @@ +# 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. + +incl_HEADERS = *.hpp +incldir = $(prefix)/include/modules/scheme + +moddir = $(prefix)/modules/scheme + +scheme_test_SOURCES = scheme-test.cpp + +scheme_shell_SOURCES = scheme-shell.cpp + +value_element_SOURCES = value-element.cpp +value_element_LDFLAGS = + +element_value_SOURCES = element-value.cpp +element_value_LDFLAGS = + +xml_value_SOURCES = xml-value.cpp +xml_value_LDFLAGS = -lxml2 + +value_xml_SOURCES = value-xml.cpp +value_xml_LDFLAGS = -lxml2 + +json_value_SOURCES = json-value.cpp +json_value_LDFLAGS = -lmozjs + +value_json_SOURCES = value-json.cpp +value_json_LDFLAGS = -lmozjs + +noinst_PROGRAMS = scheme-test +mod_PROGRAMS = scheme-shell element-value value-element xml-value value-xml json-value value-json +TESTS = scheme-test diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/driver.hpp b/sca-cpp/branches/lightweight-sca/modules/scheme/driver.hpp new file mode 100644 index 0000000000..112c226ed1 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/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_scheme_driver_hpp +#define tuscany_scheme_driver_hpp + +/** + * Script evaluator main driver loop. + */ + +#include "string.hpp" +#include "stream.hpp" +#include "eval.hpp" + +namespace tuscany { +namespace scheme { + +const string evalOutputPrompt("; "); +const string evalInputPrompt("=> "); + +const bool promptForInput(const string& str, ostream& out) { + out << endl << endl << str; + return true; +} + +const bool announceOutput(const string str, ostream& out) { + out << endl << str; + return true; +} + +const bool userPrint(const value val, ostream& out) { + if(isCompoundProcedure(val)) + writeValue(mklist<value>(compoundProcedureSymbol, procedureParameters(val), procedureBody(val), "<procedure-env>"), out); + writeValue(val, out); + return true; +} + +const value evalDriverLoop(istream& in, ostream& out, Env& env) { + promptForInput(evalInputPrompt, out); + value input = readValue(in); + if (isNil(input)) + return input; + const value output = evalExpr(input, env); + announceOutput(evalOutputPrompt, out); + userPrint(output, out); + return evalDriverLoop(in, out, env); +} + +const bool evalDriverRun(istream& in, ostream& out) { + setupDisplay(out); + Env env = setupEnvironment(); + evalDriverLoop(in, out, env); + return true; +} + +} +} +#endif /* tuscany_scheme_driver_hpp */ diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/element-value.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/element-value.cpp new file mode 100644 index 0000000000..8a443dbdb2 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/element-value.cpp @@ -0,0 +1,46 @@ +/* + * 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$ */ + +/** + * Convert a scheme value representing an element to a value. + */ + +#include "fstream.hpp" +#include "string.hpp" +#include "element.hpp" +#include "eval.hpp" + +namespace tuscany { +namespace scheme { + +int elementValue() { + const value v = elementsToValues(readValue(cin)); + cout << writeValue(v); + return 0; +} + +} +} + +int main() { + return tuscany::scheme::elementValue(); +} + diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/environment.hpp b/sca-cpp/branches/lightweight-sca/modules/scheme/environment.hpp new file mode 100644 index 0000000000..303a37cb3c --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/environment.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_scheme_environment_hpp +#define tuscany_scheme_environment_hpp + +/** + * Script evaluator environment implementation. + */ + +#include "string.hpp" +#include "list.hpp" +#include "value.hpp" +#include "primitive.hpp" +#include <string> + +namespace tuscany { +namespace scheme { + +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_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)) + logStream() << "Too many arguments supplied " << values << endl; + return frameSoFar; + } + if (isDotVariable(car(variables))) + return makeBinding(frameSoFar, cdr(variables), mklist<value>(values)); + + if (isNil(values)) { + if (!isNil(variables)) + logStream() << "Too few arguments supplied " << variables << endl; + 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_ptr<Frame> makeFrame(const list<value>& variables, const list<value> values) { + gc_ptr<Frame> frame = new (gc_new<Frame>()) Frame(); + *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)))) { + if (isNil(cdr(cdr(exps)))) + return value(); + 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) { + return cons<value>(makeFrame(vars, vals), baseEnv); +} + +const Env setupEnvironment() { + Env env = extendEnvironment(primitiveProcedureNames(), primitiveProcedureObjects(), theEmptyEnvironment()); + 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()) { + logStream() << "Unbound variable " << var << endl; + 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_scheme_environment_hpp */ diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/eval.hpp b/sca-cpp/branches/lightweight-sca/modules/scheme/eval.hpp new file mode 100644 index 0000000000..34d1a7bc17 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/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_scheme_eval_hpp +#define tuscany_scheme_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 scheme { + +const value evalExpr(const value& exp, Env& env); + +const value compoundProcedureSymbol("compound-procedure"); +const value procedureSymbol("procedure"); +const value applySymbol("apply"); +const value beginSymbol("begin"); +const value condSymbol("cond"); +const value elseSymbol("else"); +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) { + if(isNil(exps)) + return list<value> (); + return cons(evalExpr(car(exps), env), listOfValues(cdr(exps), env)); +} + +const value applyOperat(const value& exp) { + return cadr((list<value> )exp); +} + +const value applyOperand(const value& exp) { + return caddr((list<value> )exp); +} + +const bool isCompoundProcedure(const value& procedure) { + return isTaggedList(procedure, procedureSymbol); +} + +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) { + if(isLastExp(exps)) + return evalExpr(firstExp(exps), env); + evalExpr(firstExp(exps), env); + return evalSequence(restExp(exps), env); +} + +const value applyProcedure(const value& procedure, list<value>& arguments) { + if(isPrimitiveProcedure(procedure)) + return applyPrimitiveProcedure(procedure, arguments); + if(isCompoundProcedure(procedure)) { + Env env = extendEnvironment(procedureParameters(procedure), arguments, procedureEnvironment(procedure)); + return evalSequence(procedureBody(procedure), env); + } + logStream() << "Unknown procedure type " << procedure << endl; + 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)); + logStream() << "else clause isn't last " << clauses << endl; + 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) { + if(isTrue(evalExpr(ifPredicate(exp), env))) + return evalExpr(ifConsequent(exp), env); + return evalExpr(ifAlternative(exp), env); +} + +const value evalDefinition(const value& exp, Env& env) { + defineVariable(definitionVariable(exp), evalExpr(definitionValue(exp), env), env); + return definitionVariable(exp); +} + +const value evalExpr(const value& exp, Env& env) { + if(isSelfEvaluating(exp)) + return exp; + if(isQuoted(exp)) + return textOfQuotation(exp); + if(isDefinition(exp)) + return evalDefinition(exp, env); + if(isIf(exp)) + return evalIf(exp, env); + if(isBegin(exp)) + return evalSequence(beginActions(exp), env); + if(isCond(exp)) + return evalExpr(condToIf(exp), env); + 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); + return applyProcedure(evalExpr(applyOperat(exp), env), applyOperandValues); + } + if(isApplication(exp)) { + list<value> operandValues = listOfValues(operands(exp), env); + return applyProcedure(evalExpr(operat(exp), env), operandValues); + } + logStream() << "Unknown expression type " << exp << endl; + 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, scheme::Env& env) { + if (isNil(script)) + return scheme::evalExpr(expr, env); + scheme::evalExpr(car(script), env); + return evalScriptLoop(expr, cdr(script), env); +} + +const value evalScript(const value& expr, const value& script, Env& env) { + return evalScriptLoop(expr, script, env); +} + +/** + * Evaluate an expression against a script provided as an input stream. + */ +const value evalScript(const value& expr, istream& is, Env& env) { + return evalScript(expr, readScript(is), env); +} + +} +} +#endif /* tuscany_scheme_eval_hpp */ diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/io.hpp b/sca-cpp/branches/lightweight-sca/modules/scheme/io.hpp new file mode 100644 index 0000000000..8f9d70e7fe --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/io.hpp @@ -0,0 +1,239 @@ +/* + * 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_scheme_io_hpp +#define tuscany_scheme_io_hpp + +/** + * Script evaluator IO functions. + */ + +#include <ctype.h> +#include "stream.hpp" +#include "string.hpp" + +#include "list.hpp" +#include "value.hpp" +#include "primitive.hpp" + +namespace tuscany { +namespace scheme { + +const value rightParenthesis(mklist<value>(")")); +const value leftParenthesis(mklist<value>("(")); +const value comment(mklist<value>(";")); + +const double stringToNumber(const string& str) { + return atof(c_str(str)); +} + +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(istream& in) { + if(in.eof()) { + return -1; + } + char c = (char)get(in); + return c; +} + +const char peekChar(istream& in) { + if(eof(in)) + return -1; + char c = (char)peek(in); + return c; +} + +const bool isQuote(const value& token) { + return token == quoteSymbol; +} + +const failable<value> skipComment(istream& in); +const value readQuoted(istream& in); +const value readIdentifier(const char chr, istream& in); +const value readString(istream& in); +const value readNumber(const char chr, istream& in); +const value readValue(istream& in); + +const failable<value> readToken(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(in); + if(isIdentifierStart(firstChar)) + return readIdentifier(firstChar, in); + if(isDigit(firstChar)) + return readNumber(firstChar, in); + if(firstChar == -1) + return mkfailure<value>(); + logStream() << "Illegal lexical syntax '" << firstChar << "'" << endl; + return readToken(in); +} + +const failable<value> skipComment(istream& in) { + const char nextChar = readChar(in); + if (nextChar == '\n') + return readToken(in); + return skipComment(in); +} + +const value readQuoted(istream& in) { + return mklist(quoteSymbol, readValue(in)); +} + +const list<value> readList(const list<value>& listSoFar, istream& in) { + const failable<value> ftoken = readToken(in); + if (!hasContent(ftoken)) + return reverse(listSoFar); + const value token = content(ftoken); + if(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 string listToString(const list<char>& l) { + if(isNil(l)) + return ""; + const char buf[1] = { car(l) }; + return string(buf, 1) + listToString(cdr(l)); +} + +const list<char> readIdentifierHelper(const list<char>& listSoFar, 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, istream& in) { + const value val = c_str(listToString(readIdentifierHelper(mklist(chr), in))); + if (val == "false") + return value((bool)false); + if (val == "true") + return value((bool)true); + if (val == "nil") + return value(); + return val; +} + +const list<char> readStringHelper(const list<char>& listSoFar, istream& in) { + const char nextChar = readChar(in); + if(nextChar == -1 || nextChar == '"') + return reverse(listSoFar); + if (nextChar == '\\') { + const char escapedChar = readChar(in); + if (escapedChar == -1) + return reverse(listSoFar); + return readStringHelper(cons(escapedChar, listSoFar), in); + } + return readStringHelper(cons(nextChar, listSoFar), in); +} + +const value readString(istream& in) { + return listToString(readStringHelper(list<char>(), in)); +} + +const list<char> readNumberHelper(const list<char>& listSoFar, 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, istream& in) { + return stringToNumber(listToString(readNumberHelper(mklist(chr), in))); +} + +const value readValue(istream& in) { + const failable<value> fnextToken = readToken(in); + if (!hasContent(fnextToken)) + return value(); + const value nextToken = content(fnextToken); + if(isLeftParenthesis(nextToken)) + return readList(list<value>(), in); + return nextToken; +} + +const value readValue(const string s) { + istringstream in(s); + const failable<value> fnextToken = readToken(in); + if (!hasContent(fnextToken)) + return value(); + const value nextToken = content(fnextToken); + if(isLeftParenthesis(nextToken)) + return readList(list<value>(), in); + return nextToken; +} + +const bool writeValue(const value& val, ostream& out) { + out << val; + return true; +} + +const string writeValue(const value& val) { + ostringstream out; + out << val; + return str(out); +} + +const value readScript(istream& in) { + const value val = readValue(in); + if (isNil(val)) + return list<value>(); + return cons(val, (list<value>)readScript(in)); +} + +} +} +#endif /* tuscany_scheme_io_hpp */ diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/json-value.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/json-value.cpp new file mode 100644 index 0000000000..4bdf8bd37f --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/json-value.cpp @@ -0,0 +1,52 @@ +/* + * 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$ */ + +/** + * Convert a JSON document to a scheme value. + */ + +#include "fstream.hpp" +#include "string.hpp" +#include "../json/json.hpp" +#include "element.hpp" +#include "eval.hpp" + +namespace tuscany { +namespace scheme { + +int jsonValue() { + const js::JSContext cx; + const failable<list<value> > lv = json::readJSON(streamList(cin), cx); + if (!hasContent(lv)) { + cerr << reason(lv) << " : " << rcode(lv); + return 1; + } + cout << writeValue(content(lv)); + return 0; +} + +} +} + +int main() { + return tuscany::scheme::jsonValue(); +} + diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/primitive.hpp b/sca-cpp/branches/lightweight-sca/modules/scheme/primitive.hpp new file mode 100644 index 0000000000..59aee12073 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/primitive.hpp @@ -0,0 +1,288 @@ +/* + * 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_scheme_primitive_hpp +#define tuscany_scheme_primitive_hpp + +/** + * Script evaluator primitive functions. + */ + +#include "stream.hpp" +#include "function.hpp" +#include "list.hpp" +#include "value.hpp" +#include "parallel.hpp" + +namespace tuscany { +namespace scheme { + +const value primitiveSymbol("primitive"); +const value quoteSymbol("'"); +const value lambdaSymbol("lambda"); + +#ifdef WANT_THREADS +perthread_ptr<ostream> displayOutStream; +#else +ostream* displayOutStream = NULL; +#endif + +#ifdef WANT_THREADS +perthread_ptr<ostream> logOutStream; +#else +ostream* logOutStream = NULL; +#endif + +const bool setupDisplay(ostream& out) { + displayOutStream = &out; + return true; +} + +ostream& displayStream() { + if (displayOutStream == NULL) + return cout; + return *displayOutStream; +} + +const bool setupLog(ostream& out) { + logOutStream = &out; + return true; +} + +ostream& logStream() { + if (logOutStream == NULL) + return cerr; + return *logOutStream; +} + +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 assocProc(const list<value>& args) { + return assoc(car(args), (list<list<value> >)cadr(args)); +} + +const value nulProc(const list<value>& args) { + const value v(car(args)); + if (isNil(v)) + return true; + if (isList(v)) + return isNil(list<value>(v)); + return false; +} + +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) { + if (isNil(args)) { + displayStream() << endl; + return true; + } + displayStream() << car(args); + return displayProc(cdr(args)); +} + +const value logProc(const list<value>& args) { + if (isNil(args)) { + logStream() << endl; + return true; + } + logStream() << car(args); + return logProc(cdr(args)); +} + +const value uuidProc(unused const list<value>& args) { + return mkuuid(); +} + +const value cadrProc(const list<value>& args) { + return cadr((list<value> )car(args)); +} + +const value caddrProc(const list<value>& args) { + return caddr((list<value> )car(args)); +} + +const value cadddrProc(const list<value>& args) { + return cadddr((list<value> )car(args)); +} + +const value cddrProc(const list<value>& args) { + return cddr((list<value> )car(args)); +} + +const value cdddrProc(const list<value>& args) { + return cdddr((list<value> )car(args)); +} + +const value appendProc(const list<value>& args) { + return append((list<value> )car(args), (list<value>)cadr(args)); +} + +const value startProc(unused const list<value>& args) { + return lambda<value(const list<value>&)>(); +} + +const value stopProc(unused const list<value>& args) { + return lambda<value(const list<value>&)>(); +} + +const value applyPrimitiveProcedure(const value& proc, list<value>& args) { + const lambda<value(const 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(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(const list<value>&)>)f); +} + +const list<value> primitiveProcedureNames() { + return mklist<value>("car") + + "cdr" + + "cons" + + "list" + + "nul" + + "=" + + "equal?" + + "+" + + "-" + + "*" + + "/" + + "assoc" + + "cadr" + + "caddr" + + "cadddr" + + "cddr" + + "cdddr" + + "append" + + "display" + + "log" + + "uuid" + + "start" + + "stop"; +} + +const list<value> primitiveProcedureObjects() { + return mklist(primitiveProcedure(carProc)) + + primitiveProcedure(cdrProc) + + primitiveProcedure(consProc) + + primitiveProcedure(listProc) + + primitiveProcedure(nulProc) + + primitiveProcedure(equalProc) + + primitiveProcedure(equalProc) + + primitiveProcedure(addProc) + + primitiveProcedure(subProc) + + primitiveProcedure(mulProc) + + primitiveProcedure(divProc) + + primitiveProcedure(assocProc) + + primitiveProcedure(cadrProc) + + primitiveProcedure(caddrProc) + + primitiveProcedure(cadddrProc) + + primitiveProcedure(cddrProc) + + primitiveProcedure(cdddrProc) + + primitiveProcedure(appendProc) + + primitiveProcedure(displayProc) + + primitiveProcedure(logProc) + + primitiveProcedure(uuidProc) + + primitiveProcedure(startProc) + + primitiveProcedure(stopProc); +} + +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_scheme_primitive_hpp */ diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/scheme-shell.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/scheme-shell.cpp new file mode 100644 index 0000000000..4aa67c2375 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/scheme-shell.cpp @@ -0,0 +1,36 @@ +/* + * 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 "gc.hpp" +#include "stream.hpp" +#include "string.hpp" +#include "driver.hpp" + +int main() { + tuscany::gc_scoped_pool pool; + tuscany::scheme::evalDriverRun(tuscany::cin, tuscany::cout); + return 0; +} diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/scheme-test.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/scheme-test.cpp new file mode 100644 index 0000000000..5b69b8e588 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/scheme-test.cpp @@ -0,0 +1,242 @@ +/* + * 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 "stream.hpp" +#include "string.hpp" +#include "driver.hpp" + +namespace tuscany { +namespace scheme { + +bool testEnv() { + gc_scoped_pool pool; + Env globalEnv = list<value>(); + Env env = extendEnvironment(mklist<value>("a"), mklist<value>(1), globalEnv); + 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(checkValueCounters()); + assert(checkLambdaCounters()); + assert(checkListCounters()); + return true; +} + +bool testRead() { + istringstream is("abcd"); + assert(readValue(is) == "abcd"); + + istringstream is2("123"); + assert(readValue(is2) == value(123)); + + istringstream is3("(abcd)"); + assert(readValue(is3) == mklist(value("abcd"))); + + istringstream is4("(abcd xyz)"); + assert(readValue(is4) == mklist<value>("abcd", "xyz")); + + 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)); + ostringstream os; + writeValue(a, os); + istringstream is(str(os)); + assert(readValue(is) == a); + } + { + const list<value> i = mklist<value>("x", value()); + const list<value> a = mklist<value>(i); + ostringstream os; + writeValue(a, os); + istringstream is(str(os)); + assert(readValue(is) == a); + } + return true; +} + +const string testSchemeNumber( + "(define (testNumber) (if (= 1 1) (display \"testNumber ok\") (error \"testNumber\"))) " + "(testNumber)"); + +const string testSchemeString( + "(define (testString) (if (= \"abc\" \"abc\") (display \"testString ok\") (error \"testString\"))) " + "(testString)"); + +const string testSchemeDefinition( + "(define a \"abc\") (define (testDefinition) (if (= a \"abc\") (display \"testDefinition ok\") (error \"testDefinition\"))) " + "(testDefinition)"); + +const string testSchemeIf( + "(define (testIf) (if (= \"abc\" \"abc\") (if (= \"xyz\" \"xyz\") (display \"testIf ok\") (error \"testNestedIf\")) (error \"testIf\"))) " + "(testIf)"); + +const string testSchemeCond( + "(define (testCond) (cond ((= \"abc\" \"abc\") (display \"testCond ok\")) (else (error \"testIf\"))))" + "(testCond)"); + +const 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 string testSchemeLambda( + "(define sqrt (lambda (x) (* x x))) " + "(define (testLambda) (if (= 4 (sqrt 2)) (display \"testLambda ok\") (error \"testLambda\"))) " + "(testLambda)"); + +const string testSchemeForward( + "(define (testLambda) (if (= 4 (sqrt 2)) (display \"testForward ok\") (error \"testForward\"))) " + "(define sqrt (lambda (x) (* x x))) " + "(testLambda)"); + +const string evalOutput(const string& scm) { + istringstream is(scm); + ostringstream os; + evalDriverRun(is, os); + return str(os); +} + +bool testEval() { + gc_scoped_pool pool; + 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_scoped_pool pool; + const value exp = mklist<value>("+", 2, 3); + Env env = setupEnvironment(); + const value r = evalExpr(exp, env); + assert(r == value(5)); + return true; +} + +bool testEvalRun() { + gc_scoped_pool pool; + evalDriverRun(cin, cout); + return true; +} + +const value mult(const list<value>& args) { + const double x = car(args); + const double y = cadr(args); + return x * y; +} + +const string testReturnLambda( + "(define (testReturnLambda) * )"); + +const string testCallLambda( + "(define (testCallLambda l x y) (l x y))"); + +bool testEvalLambda() { + gc_scoped_pool pool; + Env env = setupEnvironment(); + + const value trl = mklist<value>("testReturnLambda"); + istringstream trlis(testReturnLambda); + const value trlv = evalScript(trl, trlis, env); + + istringstream tclis(testCallLambda); + const value tcl = cons<value>("testCallLambda", quotedParameters(mklist<value>(trlv, 2, 3))); + const value tclv = evalScript(tcl, tclis, env); + assert(tclv == value(6)); + + istringstream tcelis(testCallLambda); + const value tcel = cons<value>("testCallLambda", quotedParameters(mklist<value>(primitiveProcedure(mult), 3, 4))); + const value tcelv = evalScript(tcel, tcelis, env); + assert(tcelv == value(12)); + return true; +} + +bool testEvalGC() { + resetLambdaCounters(); + resetListCounters(); + resetValueCounters(); + testEval(); + testEvalExpr(); + testEvalLambda(); + assert(checkValueCounters()); + assert(checkLambdaCounters()); + assert(checkListCounters()); + return true; +} + +} +} + +int main() { + tuscany::gc_scoped_pool p; + tuscany::cout << "Testing..." << tuscany::endl; + + tuscany::scheme::testEnv(); + tuscany::scheme::testEnvGC(); + tuscany::scheme::testRead(); + tuscany::scheme::testWrite(); + tuscany::scheme::testEval(); + tuscany::scheme::testEvalExpr(); + tuscany::scheme::testEvalLambda(); + tuscany::scheme::testEvalGC(); + + tuscany::cout << "OK" << tuscany::endl; + return 0; +} diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/value-element.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/value-element.cpp new file mode 100644 index 0000000000..a4acdaf2d7 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/value-element.cpp @@ -0,0 +1,46 @@ +/* + * 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$ */ + +/** + * Convert a scheme value to a value representing an element. + */ + +#include "fstream.hpp" +#include "string.hpp" +#include "element.hpp" +#include "eval.hpp" + +namespace tuscany { +namespace scheme { + +int valueElement() { + const value v = valuesToElements(readValue(cin)); + cout << writeValue(v); + return 0; +} + +} +} + +int main() { + return tuscany::scheme::valueElement(); +} + diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/value-json.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/value-json.cpp new file mode 100644 index 0000000000..a8c875fcc8 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/value-json.cpp @@ -0,0 +1,52 @@ +/* + * 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$ */ + +/** + * Convert a scheme value to a JSON document. + */ + +#include "fstream.hpp" +#include "string.hpp" +#include "../json/json.hpp" +#include "element.hpp" +#include "eval.hpp" + +namespace tuscany { +namespace scheme { + +int valueJSON() { + const js::JSContext cx; + failable<list<string> > s = json::writeJSON(readValue(cin), cx); + if (!hasContent(s)) { + cerr << reason(s) << " : " << rcode(s); + return 1; + } + write(content(s), cout); + return 0; +} + +} +} + +int main() { + return tuscany::scheme::valueJSON(); +} + diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/value-xml.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/value-xml.cpp new file mode 100644 index 0000000000..ff785899c6 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/value-xml.cpp @@ -0,0 +1,51 @@ +/* + * 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$ */ + +/** + * Convert a scheme value to an XML document. + */ + +#include "fstream.hpp" +#include "string.hpp" +#include "xml.hpp" +#include "element.hpp" +#include "eval.hpp" + +namespace tuscany { +namespace scheme { + +int valueXML() { + failable<list<string> > s = writeXML(readValue(cin)); + if (!hasContent(s)) { + cerr << reason(s) << " : " << rcode(s); + return 1; + } + write(content(s), cout); + return 0; +} + +} +} + +int main() { + return tuscany::scheme::valueXML(); +} + diff --git a/sca-cpp/branches/lightweight-sca/modules/scheme/xml-value.cpp b/sca-cpp/branches/lightweight-sca/modules/scheme/xml-value.cpp new file mode 100644 index 0000000000..d88f754aa5 --- /dev/null +++ b/sca-cpp/branches/lightweight-sca/modules/scheme/xml-value.cpp @@ -0,0 +1,47 @@ +/* + * 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$ */ + +/** + * Convert an XML document to a scheme value. + */ + +#include "fstream.hpp" +#include "string.hpp" +#include "xml.hpp" +#include "element.hpp" +#include "eval.hpp" + +namespace tuscany { +namespace scheme { + +int xmlValue() { + const value v = readXML(streamList(cin)); + cout << writeValue(v); + return 0; +} + +} +} + +int main() { + return tuscany::scheme::xmlValue(); +} + |