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