From e982b4ef38fd043c15e89bdd60763b10434a087e Mon Sep 17 00:00:00 2001 From: jsdelfino Date: Sun, 28 Feb 2010 19:40:06 +0000 Subject: Moving old inactive code to a branch as it's confusing code assist, searches and indexing in trunk. git-svn-id: http://svn.us.apache.org/repos/asf/tuscany@917273 13f79535-47bb-0310-9956-ffa450edef68 --- .../cpp-contrib/modules/scheme/primitive.hpp | 285 +++++++++++++++++++++ 1 file changed, 285 insertions(+) create mode 100644 sca-cpp/branches/cpp-contrib/modules/scheme/primitive.hpp (limited to 'sca-cpp/branches/cpp-contrib/modules/scheme/primitive.hpp') diff --git a/sca-cpp/branches/cpp-contrib/modules/scheme/primitive.hpp b/sca-cpp/branches/cpp-contrib/modules/scheme/primitive.hpp new file mode 100644 index 0000000000..fd5f3e9755 --- /dev/null +++ b/sca-cpp/branches/cpp-contrib/modules/scheme/primitive.hpp @@ -0,0 +1,285 @@ +/* + * 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 +#include +#include "stream.hpp" +#include "function.hpp" +#include "list.hpp" +#include "value.hpp" + +namespace tuscany { +namespace scheme { + +const value primitiveSymbol("primitive"); +const value quoteSymbol("'"); +const value lambdaSymbol("lambda"); + +#ifdef WANT_THREADS +__thread +#endif +ostream* displayOutStream = NULL; + +#ifdef WANT_THREADS +__thread +#endif +ostream* logOutStream = NULL; + +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& 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 assocProc(const list& args) { + return assoc(car(args), (list >)cadr(args)); +} + +const value nulProc(const list& args) { + const value v(car(args)); + if (isNil(v)) + return true; + if (isList(v)) + return isNil(list(v)); + return false; +} + +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) { + if (isNil(args)) { + displayStream() << endl; + return true; + } + displayStream() << car(args); + return displayProc(cdr(args)); +} + +const value logProc(const list& args) { + if (isNil(args)) { + logStream() << endl; + return true; + } + logStream() << car(args); + return logProc(cdr(args)); +} + +const value uuidProc(unused const list& args) { + apr_uuid_t uuid; + apr_uuid_get(&uuid); + char buf[APR_UUID_FORMATTED_LENGTH]; + apr_uuid_format(buf, &uuid); + return string(buf, APR_UUID_FORMATTED_LENGTH); +} + +const value cadrProc(unused const list& args) { + return cadr((list )car(args)); +} + +const value caddrProc(unused const list& args) { + return caddr((list )car(args)); +} + +const value cadddrProc(unused const list& args) { + return cadddr((list )car(args)); +} + +const value cddrProc(unused const list& args) { + return cddr((list )car(args)); +} + +const value cdddrProc(unused const list& args) { + return cdddr((list )car(args)); +} + +const value startProc(unused const list& args) { + return lambda&)>(); +} + +const value stopProc(unused const list& args) { + return lambda&)>(); +} + +const value applyPrimitiveProcedure(const value& proc, list& args) { + 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(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() { + return mklist("car") + + "cdr" + + "cons" + + "list" + + "nul" + + "=" + + "equal?" + + "+" + + "-" + + "*" + + "/" + + "assoc" + + "cadr" + + "caddr" + + "cadddr" + + "cddr" + + "cdddr" + + "display" + + "log" + + "uuid" + + "start" + + "stop"; +} + +const list 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(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 )exp)); +} + +const value makeLambda(const list& parameters, const list& body) { + return cons(lambdaSymbol, cons(parameters, body)); +} + +} +} +#endif /* tuscany_scheme_primitive_hpp */ -- cgit v1.2.3