ValuePtr apply(EnvPtr env, ValuePtr procedure, ValuePtr args) { if(procedure->type() == Value::NATIVE_PROCEDURE) { NativeProcedureValue* proc = static_cast<NativeProcedureValue*>(procedure.mValue); return (*proc->mProc)(env, args); } else if(procedure->type() == Value::PROCEDURE) { EnvPtr callEnvironment = new Environment; ProcedureValue* proc = static_cast<ProcedureValue*>(procedure.mValue); callEnvironment->parent = proc->environment; int iParam = 0; while(args->isNull() == false) { if(iParam == static_cast<int>(proc->paramList.size())) { CHECK_FAIL("Too many arguments to procedure"); } callEnvironment->values[proc->paramList[iParam]] = args->car(); iParam++; args = args->cdr(); } if(iParam != static_cast<int>(proc->paramList.size())) { CHECK_FAIL("Too few arguments to procedure"); } return evalSequence(callEnvironment, proc->body); } else { sWrite(env, new PairValue(procedure, new PairValue())); CHECK_FAIL("Wrong type of argument to apply: not procedure"); return NULL; } }
sExpression *apply(sExpression *procOrLambda, sExpression *argument, sEnvironment *env){ if(isPrimitiveProc(procOrLambda)) { sProc *cfunc = toProc(procOrLambda); return applyProc(cfunc, argument); } else if(isLambdaType(procOrLambda)) { sLambda *lambd = toLambda(procOrLambda); sList *body = lambd->body; sList *arguments; sList *parameters; if(isList(argument)){ //可変長引数のため parameters = checkParameters(lambd->parameters, toList(argument)); arguments = checkArguments(parameters, toList(argument), lambd->isVarArgument); }else{ parameters = lambd->parameters; arguments = toList(cons(argument, &sNull)); } sEnvironment *env = extendEnvironment(parameters, arguments, lambd->frame); if(isList(car(body))){ return evalSequence(body, env); }else{ return eval(newExp(body, LIST_TAG), env); } } return &sNull; }
sExpression *evalSequence(sList *exps, sEnvironment *env){ if(isLastExp(exps)){ return eval(firstExp(exps), env); }else{ eval(firstExp(exps), env); return evalSequence(restExp(exps), env); } }
ValuePtr evalLet(EnvPtr env, ValuePtr statement) { EnvPtr letEnv = new Environment(); letEnv->parent = env; ValuePtr bindings = statement->cdr()->car(); CHECK("One or more expressions", sLength(statement) >= 3); CHECK("Let bindings are a list", sListP(bindings)); while(bindings->isNull() == false) { CHECK("Let assignment is a list", sListP(bindings->car())); CHECK("Let assignment is a 2 item list", sLength(bindings->car()) == 2); ValuePtr variable = bindings->car()->car(); CHECK("Assigning to a symbol", variable->isSymbol()); ValuePtr value = eval(env, bindings->car()->cdr()->car()); letEnv->values[variable->vString()] = value; bindings = bindings->cdr(); } return evalSequence(letEnv, statement->cdr()->cdr()); }
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(); }