bool
sEqP(ValuePtr lhs, ValuePtr rhs)
{
if(lhs->type() != rhs->type()) return false;
if(lhs->isBool() && lhs->vBool() == rhs->vBool()) return true;
else if(lhs->isNumber() && lhs->isExact() && rhs->isExact() && lhs->vInt() == rhs->vInt()) return true;
else if(lhs->isNumber() && !lhs->isExact() && !rhs->isExact() && lhs->vFloat() == rhs->vFloat()) return true;
else if(lhs->isString() && string(lhs->vString()) == string(rhs->vString())) return true;
else if(lhs->isSymbol() && string(lhs->vString()) == string(rhs->vString())) return true;
else if(lhs->isPair() && (lhs == rhs || (lhs->isNull() && rhs->isNull()))) return true;
else if(lhs->isProcedure() && (lhs.mValue == rhs.mValue)) return true;
else if(lhs->type() == Value::UNDEFINED) return false;
return false;
}
void
TestEval::eval_conditionals()
{
EnvPtr env = libraryEnvironment();
ValuePtr result = eval(env, "(if #t 'yes 'no)");
CHECK("Symbol type", result->isSymbol());
CHECK_EQUAL("Symbol result", string, "yes", result->vString());
result = eval(env, "(and '(foo) (= 10 10) 1)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(and '(foo) (= 10 20) 1)");
CHECK("Result is false", result->isBool() && !result->vBool());
result = eval(env, "(or (= 10 20) 10 1)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(or #f (= 10 20) (< 10 5))");
CHECK("Result is false", result->isBool() && !result->vBool());
}
ValuePtr
evalLet(EnvPtr env, ValuePtr statement)
{
EnvPtr letEnv = new Environment();
letEnv->parent = env;
ValuePtr bindings = statement->cdr()->car();
CHECK("One or more expressions", sLength(statement) >= 3);
CHECK("Let bindings are a list", sListP(bindings));
while(bindings->isNull() == false) {
CHECK("Let assignment is a list", sListP(bindings->car()));
CHECK("Let assignment is a 2 item list", sLength(bindings->car()) == 2);
ValuePtr variable = bindings->car()->car();
CHECK("Assigning to a symbol", variable->isSymbol());
ValuePtr value = eval(env, bindings->car()->cdr()->car());
letEnv->values[variable->vString()] = value;
bindings = bindings->cdr();
}
return evalSequence(letEnv, statement->cdr()->cdr());
}
ValuePtr
eval(EnvPtr env, ValuePtr data)
{
// Self evaluating
if(data->isBool() ||
data->isNumber() ||
data->isString()) {
return data;
}
// Symbols
else if(data->isSymbol()) {
EnvPtr current = env;
while(!(NULL == current)) {
if(current->values.find(data->vString()) != current->values.end()) {
return current->values[data->vString()];
}
current = current->parent;
}
CHECK_FAIL(string("Trying to access unknown symbol: ") + data->vString());
}
// Lists
else if(data->isPair()) {
if(!sListP(data)) {
CHECK_FAIL("Unable to evaluate non-lists");
return rsUndefined();
}
// ----------------------------------------
// Check for special forms
if(data->car()->isSymbol()) {
// ----------------------------------------
// Quote
if(data->car()->vString() == string("quote")) {
if(data->cdr()->isPair() &&
data->cdr()->cdr()->isNull())
return data->cdr()->car();
else
CHECK_FAIL("Quote error");
}
// ----------------------------------------
// Lambda
else if(data->car()->vString() == string("lambda")) {
if(sListP(data->cdr()->car())) {
return evalLambda(env, data->cdr()->car(), data->cdr()->cdr());
}
else {
CHECK_FAIL("Malformed lambda parameter sequence");
return rsUndefined();
}
}
// ----------------------------------------
// Definitions: define, set!
else if(data->car()->vString() == string("define")) {
return evalDefine(env, data);
}
else if(data->car()->vString() == string("set!")) {
return evalSet(env, data);
}
// ----------------------------------------
// Conditionals and boolean: if, cond
else if(data->car()->vString() == string("if")) {
return evalIf(env, data);
}
else if(data->car()->vString() == string("cond")) {
return evalCond(env, data);
}
else if(data->car()->vString() == string("and")) {
return evalAnd(env, data);
}
else if(data->car()->vString() == string("or")) {
return evalOr(env, data);
}
// ----------------------------------------
// Binding constructs
else if(data->car()->vString() == string("let")) {
return evalLet(env, data);
}
// ----------------------------------------
// Sequencing
else if(data->car()->vString() == string("begin")) {
return evalSequence(env, data->cdr());
}
}
// Ok, standard statement
return evalStatement(env, data);
}
else {
CHECK_FAIL("Trying to evaluate unknown type");
}
CHECK_FAIL("Eval error, this should never be reachable");
return rsUndefined();
}