From c9bfccc35345ce58fb5774d4b0b6a9868b262c0a Mon Sep 17 00:00:00 2001 From: giorgio Date: Wed, 5 Sep 2012 08:31:30 +0000 Subject: git-svn-id: http://svn.us.apache.org/repos/asf/tuscany@1381061 13f79535-47bb-0310-9956-ffa450edef68 --- .../lightweight-sca/modules/scheme/environment.hpp | 182 +++++++++++++++++++++ 1 file changed, 182 insertions(+) create mode 100644 sca-cpp/branches/lightweight-sca/modules/scheme/environment.hpp (limited to 'sca-cpp/branches/lightweight-sca/modules/scheme/environment.hpp') 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 + +namespace tuscany { +namespace scheme { + +typedef value Frame; +typedef list Env; + +const value trueSymbol("true"); +const value falseSymbol("false"); +const value defineSymbol("define"); +const value setSymbol("set!"); +const value dotSymbol("."); + +const Env theEmptyEnvironment() { + return list(); +} + +const bool isDefinition(const value& exp) { + return isTaggedList(exp, defineSymbol); +} + +const bool isAssignment(const value& exp) { + return isTaggedList(exp, setSymbol); +} + +const bool isVariable(const value& exp) { + return isSymbol(exp); +} + +const Env enclosingEnvironment(const Env& env) { + return cdr(env); +} + +const gc_ptr firstFrame(const Env& env) { + return car(env); +} + +list frameVariables(const Frame& frame) { + return car((list )frame); +} + +list frameValues(const Frame& frame) { + return cdr((list )frame); +} + +const bool isDotVariable(const value& var) { + return var == dotSymbol; +} + +const Frame makeBinding(const Frame& frameSoFar, const list& variables, const list values) { + if (isNil(variables)) { + if (!isNil(values)) + logStream() << "Too many arguments supplied " << values << endl; + return frameSoFar; + } + if (isDotVariable(car(variables))) + return makeBinding(frameSoFar, cdr(variables), mklist(values)); + + if (isNil(values)) { + if (!isNil(variables)) + logStream() << "Too few arguments supplied " << variables << endl; + return frameSoFar; + } + + const list vars = cons(car(variables), frameVariables(frameSoFar)); + const list vals = cons(car(values), frameValues(frameSoFar)); + const Frame newFrame = cons(value(vars), vals); + + return makeBinding(newFrame, cdr(variables), cdr(values)); +} + +const gc_ptr makeFrame(const list& variables, const list values) { + gc_ptr frame = new (gc_new()) Frame(); + *frame = value(makeBinding(cons(value(list()), list()), variables, values)); + return frame; +} + +const value definitionVariable(const value& exp) { + const list exps(exp); + if(isSymbol(car(cdr(exps)))) + return car(cdr(exps)); + const list lexps(car(cdr(exps))); + return car(lexps); +} + +const value definitionValue(const value& exp) { + const list exps(exp); + if(isSymbol(car(cdr(exps)))) { + if (isNil(cdr(cdr(exps)))) + return value(); + return car(cdr(cdr(exps))); + } + const list lexps(car(cdr(exps))); + return makeLambda(cdr(lexps), cdr(cdr(exps))); +} + +const value assignmentVariable(const value& exp) { + return car(cdr((list )exp)); +} + +const value assignmentValue(const value& exp) { + return car(cdr(cdr((list )exp))); +} + +const Frame addBindingToFrame(const value& var, const value& val, const Frame& frame) { + return cons(value(cons(var, frameVariables(frame))), cons(val, frameValues(frame))); +} + +const bool defineVariable(const value& var, const value& val, Env& env) { + *firstFrame(env) = addBindingToFrame(var, val, *firstFrame(env)); + return true; +} + +const Env extendEnvironment(const list& vars, const list& vals, const Env& baseEnv) { + return cons(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& vars, const list& vals, const Env& env) { + if(isNil(vars)) + return lookupEnvLoop(var, enclosingEnvironment(env)); + if(var == car(vars)) + return car(vals); + return lookupEnvScan(var, cdr(vars), cdr(vals), env); +} + +const value lookupEnvLoop(const value& var, const Env& env) { + if(env == theEmptyEnvironment()) { + 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 */ -- cgit v1.2.3