void
TestEval::eval_let()
{
EnvPtr env = libraryEnvironment();
ValuePtr result = eval(env, "(define a 10) (let ((b 5) (a 20)) a)");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 20, result->vInt());
result = eval(env, "(define a 10) (let ((b 5) (c 20)) a)");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 10, result->vInt());
}
void
TestLibrary::numerical_operations()
{
EnvPtr env = libraryEnvironment();
ValuePtr result;
// +
result = eval(env, "(+ 1 2 3 4 5)");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 15, result->vInt());
// =
result = eval(env, "(= 123 123 123)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(= 12.3 12.3 12.3)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(= 123 456 123)");
CHECK("Result is false", result->isBool() && !result->vBool());
// <
result = eval(env, "(< 1 2 3 4 5)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(< 1.0 2.0 3.0 4.0 5.0)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(< 6 5 4 3 2)");
CHECK("Result is false", result->isBool() && !result->vBool());
result = eval(env, "(< 10 10 10)");
CHECK("Result is false", result->isBool() && !result->vBool());
// >
result = eval(env, "(> 6 5 4 3 2)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(> 5.0 4.0 3.0 2.0 1.0)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(> 1 2 3 4 5)");
CHECK("Result is false", result->isBool() && !result->vBool());
result = eval(env, "(> 10 10 10)");
CHECK("Result is false", result->isBool() && !result->vBool());
// <=
result = eval(env, "(<= 1 2 4 4 5)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(<= 1.0 2.0 4.0 4.0 5.0)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(<= 6 5 4 3 2)");
CHECK("Result is false", result->isBool() && !result->vBool());
// >=
result = eval(env, "(>= 6 5 4 4 2)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(>= 5.0 4.0 4.0 2.0 1.0)");
CHECK("Result is true", result->isBool() && result->vBool());
result = eval(env, "(>= 1 2 3 4 5)");
CHECK("Result is false", result->isBool() && !result->vBool());
// number->string
result = eval(env, "(number->string 10)");
CHECK("Result is string", result->isString());
CHECK_EQUAL("Correct value", string, "10", result->vString());
}
void
TestEval::eval_define()
{
EnvPtr env = libraryEnvironment();
ValuePtr result = eval(env, "(define a 10) (define (foo x) (set! a x)) (let ((b 5)) (foo 20)) a");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 20, result->vInt());
}
void
TestLibrary::control_operations()
{
EnvPtr env = libraryEnvironment();
ValuePtr result;
result = eval(env, "(apply + '(1 2 3))");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 6, result->vInt());
result = eval(env, "(apply + (map car '((1 2 3) (1 2 3) (1 2 3))))");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 3, result->vInt());
result = eval(env, "(define a 10) (for-each (lambda (b) (set! a (+ a b))) '(10 20 30 40)) a");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 110, result->vInt());
}
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());
}
float
sAsFloat(ValuePtr number)
{
CHECK("Error convering non number to float", number->isNumber());
if(!number->isExact()) {
return number->vFloat();
}
else {
return static_cast<float>(number->vInt());
}
}
void
TestLibrary::pairs_lists()
{
EnvPtr env = libraryEnvironment();
ValuePtr result = eval(env, "(cdr (car (cons (cons 1 2) 3)))");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 2, result->vInt());
result = eval(env, "(car (cdr (cdr (list 1 2 3 4 5))))");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 3, result->vInt());
result = eval(env, "(define test (cons 1 2)) (set-car! test 5) (car test)");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 5, result->vInt());
result = eval(env, "(define test2 (cons 1 2)) (set-cdr! test2 10) (cdr test2)");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 10, result->vInt());
result = eval(env, "(cdr (assq 'c (list (cons 'a 1) (cons 'b 2) (cons 'c 3) (cons 'd 4))))");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 3, result->vInt());
result = eval(env, "(car (reverse '(1 2 3 4)))");
CHECK("Result is integer", result->isNumber() && result->isExact());
CHECK_EQUAL("Value is correct", int, 4, result->vInt());
}
void
TestEval::eval_lambda()
{
EnvPtr env = libraryEnvironment();
ValuePtr value = eval(env, "((lambda (a b c) (+ a b c)) 1 2 3)");
CHECK("Integer type", value->isNumber() && value->isExact());
CHECK_EQUAL("Integer content", int, 6, value->vInt());
value = eval(env, "(define foo (lambda (a b c) (+ a b c)))\n(foo 1 2 3)\n");
CHECK("Integer type", value->isNumber() && value->isExact());
CHECK_EQUAL("Integer content", int, 6, value->vInt());
value = eval(env, "\n\
(define (accum n) (lambda (a) (set! n (+ a n)) n))\n \
(define foo (accum 5))\n\
(define bar (accum 100))\n\
(foo 10) ;Comment\n\
(bar 10)\n\
(foo 10)");
CHECK("Integer type", value->isNumber() && value->isExact());
CHECK_EQUAL("Integer content", int, 25, value->vInt());
}
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
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();
}