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(); }