bool
sListP(ValuePtr data)
{
while(data->isPair() && !data->isNull())
data = data->cdr();
return data->isNull();
}
int
sLength(ValuePtr data)
{
int length = 0;
ValuePtr ptr = data;
while(ptr->isNull() == false) {
if(ptr->isPair() == false) CHECK_FAIL("Malformed list to length");
length++;
ptr = ptr->cdr();
}
return length;
}
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;
}
ValuePtr
sAssq(EnvPtr, ValuePtr args)
{
if(sLength(args) != 2)
CHECK_FAIL("Wrong number of arguments to assq");
ValuePtr obj = args->car();
ValuePtr alist = args->cdr()->car();
while(alist->isNull() == false) {
if(alist->isPair() == false && alist->car()->isPair() == false)
CHECK_FAIL("Malformed alist");
if(sEqP(obj, alist->car()->car())) {
return alist->car();
}
alist = alist->cdr();
}
return rsFalse();
}
void
TestEval::eval_simple()
{
EnvPtr env = new Environment();
env->parent = NULL;
ValuePtr value;
// bool false
value = eval(env, "#f");
CHECK("Boolean false", value->isBool() && !value->vBool());
// integer
value = eval(env, "#t");
CHECK("Boolean true", value->isBool() && value->vBool());
// integer
value = eval(env, "123");
CHECK("Integer type", value->isNumber() && value->isExact());
CHECK_EQUAL("Integer content", int, 123, value->vInt());
// double
value = eval(env, "123.456");
CHECK("Float type", value->isNumber() && !value->isExact());
CHECK_EQUAL("Float content", float, 123.456, value->vFloat());
// string
value = eval(env, "\"foobar\"");
CHECK("String type", value->isString());
CHECK_EQUAL("string content", string, "foobar", value->vString());
// Symbol
ValuePtr intValue = new NumberValue(10);
env->values["foo_symbol!"] = intValue;
value = eval(env, "foo_symbol!");
CHECK("Symbol lookup", intValue == value);
// Quote
value = eval(env, "'(foo)");
CHECK("Pair type", value->isPair());
CHECK("Empty list type", value->cdr()->isNull());
CHECK("Symbol type", value->car()->isSymbol());
CHECK_EQUAL("Symbol value", string, "foo", value->car()->vString());
}
ValuePtr
evalStatement(EnvPtr env, ValuePtr data)
{
ValuePtr current = data;
ValuePtr call = new PairValue();
ValuePtr callCurrent = call;
while(current->isPair() && !current->isNull()) {
callCurrent->car() = eval(env, current->car());
ValuePtr newParam = new PairValue();
callCurrent->cdr() = newParam;
callCurrent = newParam;
current = current->cdr();
}
if(current->isNull() == false) {
CHECK_FAIL("Malformed statement");
return NULL;
}
return apply(env, call);
}
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();
}