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();
}
sExpression *eval(sExpression *exp, sEnvironment *env){
/* ------------------atom-----------------------*/
/* 1, 10, false, null, "abc" */
if(isSelfEval(exp))
{
return exp;
}
/* a symbol */
else if(isVariable(exp, env))
{
return lookupVariable(toSymb(exp), env);
}
/* ------------------list-----------------------*/
/* (quote blur blur) */
else if(isQuoted(exp))
{
return textOfQuoted(exp);
}
/* (set! name value) */
else if(isAssignment(exp))
{
return evalAssignment(exp, env);
}
/* (define name value) */
else if(isDefinition(exp))
{
return evalDefine(exp, env);
}
/* (define-syntax name ...) */
else if(isDefinitionSyntax(exp))
{
return evalDefineSyntax(exp, env);
}
/* (if blur blur blur) */
else if(isIf(exp))
{
return evalIf(toList(exp), env);
}
/* (lambda (args) (body)) */
else if(isLambdaConst(exp))
{
sList *body;
sList *param = toList( cadr(toList(exp)));
sExpression *temp = cdr(toList( cdr(toList(exp))));
if(isList(temp)){
body = toList(temp);
}else{
body = toList(cons(temp, &sNull));
}
return newLambda(param, body, env);
}
/* (syntax blur blur) syntax rule */
else if(isSymbol(car(toList(exp))) && isSyntaxRule(eval(car(toList(exp)), env)))
{
sExpression *exp2 = evalSyntaxRule(toSyntax(eval(car(toList(exp)), env)), exp);
return eval(exp2, env);
}
/* the other list (x . y) */
else if(isApplication(exp))
{
if(LAZY_EVAL){
sExpression *proexp = actualValue(operator(toList(exp)), env);
if(isLambdaType(proexp) || isPrimitiveProc(proexp)){
sExpression *operand = operands(toList(exp));
return applyLazly(proexp, operand, env);
}
}else{
sExpression *proexp = eval(operator(toList(exp)), env);
if(isLambdaType(proexp) || isPrimitiveProc(proexp)){
sExpression *operand = operands(toList(exp));
sExpression *arguments = listOfValues(operand, env);
return apply(proexp, arguments, env);
}
}
}
return &sError;
}
// This function evaluates the parse tree given by expr within the given environment.
Value* eval(Value *expr, Environment *env){
Value* operator;
Value* args;
//printf("Here is expression: ");
//printValue(expr);
//printf("\n");
if (!expr){
return NULL;
}
switch (expr->type)
{
case symbolType:
//printf("unknown identifier");
args = envLookup(expr->symbolValue, env);
if (args){
//printf("going here\n");
//printValue(expr);
//printf("\nending here\n");
return args;
}
else{
printf("syntax error: unknown identifier");
return NULL;
}
break;
case cellType:
if (expr->cons->car->type == nullType) {
return expr->cons->car;
}
//printf("Here is expression: ");
//printValue(getFirst(expr));
//printf("\n");
if (getFirst(expr) != NULL && getFirst(expr)->type == openType) {
operator = car(expr);
if (!operator){
printf("syntax error, missing components here");
return NULL;
}
if (operator->type == cellType){
operator = eval(operator, env);
}
if (operator->type == symbolType){
args = getTail(getTail(expr));
//printf("checking args?: ");
//printValue(args);
//printf("\n"); //if (args == NULL){
//return eval(operator,env); // }else
if (strcmp(operator->symbolValue,"define")==0){
return evalDefine(args, env);
}else if (strcmp(operator->symbolValue,"lambda")==0){
/*eval lambda goes here*/
return evalLambda(args, env);
}else if (strcmp(operator->symbolValue,"if")== 0){
return evalIf(args, env);
/*eval if goes here*/
}else if (strcmp(operator->symbolValue,"quote")==0){
/*eval quote goes here*/
return evalQuote(args);
}else if (strcmp(operator->symbolValue,"let")==0){
/*eval let goes here*/
return evalLet(args, env);
}else{
//printf("validation result is shown: %d\n",validateArgs(args, env));
if (validateArgs(args, env)==-1){
printf("Syntax error! Invalid arguments for the procedure: ");
printValue(operator);
printf("\n");
return NULL;
}
Value *evaledOperator = eval(operator, env);
Value *evaledArgs = evalEach(args, env);
if (!evaledOperator){
printf("Unknown procedure: ");
printValue(operator);
printf("\n");
}
//printValue(evaledArgs);
//printf("\n");
return apply(evaledOperator, evaledArgs);
}
}else if (typeCheck(operator)==1){
printf("A literal ");
printValue(operator);
printf(" cannot be a procedure.\n");
return NULL;
}
} else if (typeCheck(getFirst(expr))==1){
//printValue(expr);
//printf("\n");
return evalEach(expr,env);
}else if (getFirst(expr) && getFirst(expr)->type ==cellType && getFirst(getTail(expr)) && getFirst(getTail(expr))->type==closeType){
return eval(getFirst(expr),env);
}else if (getFirst(expr) && getFirst(expr)->type == symbolType){
operator = getFirst(expr);
Value *returnValue = envLookup(operator->symbolValue, env);
if (returnValue){
return returnValue;
}else{
if (strcmp(operator->symbolValue,"define")==0){
printf("define: bad syntax in ");
printValue(expr);
printf("\n");
}else if (strcmp(operator->symbolValue,"lambda")==0){
printf("lambda: bad syntax in ");
printValue(expr);
printf("\n");
}else if (strcmp(operator->symbolValue,"if")==0){
printf("if: bad syntax in ");
printValue(expr);
printf("\n");
}else if (strcmp(operator->symbolValue,"quote")==0){
printf("quote: bad syntax in ");
printValue(expr);
printf("\n");
}else if (strcmp(operator->symbolValue,"let")==0){
printf("let: bad syntax in ");
printValue(expr);
printf("\n");
}else{
printf("Unknown identifier %s.\n",operator->symbolValue);
}
return NULL;
}
}
case closeType:
//printValue(expr);
//printf("\n");
return NULL;
break;
default:
//printValue(expr);
//printf("\n");
if (getTail(expr)){
assert(getFirst(getTail(expr))!=NULL);
assert(getFirst(getTail(expr))->type==closeType);
Value *toRemove = getTail(expr);
free(toRemove->cons->car);
free(toRemove->cons);
free(toRemove);
expr->cons->cdr = NULL;
//assert(1==2);
}
return expr;
}
}
// Evaluates the expression. In the frame that it is given
Value eval(Value expr, Frame *env) {
Value toRet;
switch (expr.type){
case (booleanType):
case (integerType):
case (realType):
case (stringType):
case (quotedConsType):
case (quotedSymbolType):
case (closureType):
case (primitiveType):
toRet = expr;
break;
case (symbolType):
toRet = resolveVar(expr, env);
break;
case (consType):
if( !expr.consValue ){
return evaluationError("empty expression");
}else if(expr.consValue->car.type == consType){
toRet = evalApply(expr, env);
if(toRet.type == openType){
return evaluationError("first argument in an expression did not evaluate to a proceedure");
}
break;
}else if(expr.consValue->car.type == symbolType){
char *keyword = expr.consValue->car.symbolValue;
if (strcmp(keyword, "if") == 0) {
toRet = evalIf(expr.consValue->cdr, env);
} else if (strcmp(keyword, "quote") == 0){
toRet = evalQuote(expr.consValue->cdr, env);
} else if (strcmp(keyword, "let") == 0){
toRet = evalLet(expr.consValue->cdr, env);
} else if (strcmp(keyword, "define") == 0){
toRet = evalDefine(expr.consValue->cdr, env);
} else if (strcmp(keyword, "lambda") == 0){
toRet = evalLambda(expr.consValue->cdr, env);
} else if (strcmp(keyword, "let*") == 0){
toRet = evalLetStar(expr.consValue->cdr, env);
} else if (strcmp(keyword, "letrec") == 0){
toRet = evalLetRec(expr.consValue->cdr, env);
} else if (strcmp(keyword, "begin") == 0){
toRet = evalBegin(expr.consValue->cdr, env);
} else if (strcmp(keyword, "cond") == 0){
toRet = evalCond(expr.consValue->cdr, env);
}
else {
/* not a recognized special form - must be user defined function */
toRet = evalApply(expr, env);
}
break;
}else{
return evaluationError("first argument in an expression was neither a symbol or expression");
}
case (voidType):
toRet = evaluationError("cannot evaluate void type");
default:
toRet = evaluationError(NULL);
}
return toRet;
}
