
git-svn-id: http://svn.us.apache.org/repos/asf/tuscany@1052740 13f79535-47bb-0310-9956-ffa450edef68
290 lines
8 KiB
C++
290 lines
8 KiB
C++
/*
|
|
* 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 */
|