virtual Value* eval(Environment& env) {
Value* ret = NULL;
if (exprs.size() == 0) { return NULL; }
Value *first = exprs[0]->eval(env);
ClosureValue *func = dynamic_cast<ClosureValue*>(first);
if (func) {
Environment boundEnv = func->getEnv();
vector<string> paramSyms = func->getParams();
SchemeExpression* boundBody = func->getBody();
if (paramSyms.size() == exprs.size() - 1) {
for (unsigned int i = 1; i < exprs.size(); i++) {
boundEnv.bind(paramSyms[i - 1], exprs[i]->eval(env));
}
ret = boundBody->eval(boundEnv);
for (unsigned int i = 0; i < paramSyms.size(); i++) {
boundEnv.unbind();
}
}
}
delete first;
return ret;
}
Value CL_symbol_macrolet(Value args, Environment * env, Thread * thread)
{
Value varlist = check_list(car(args));
Value result = NIL;
void * last_special_binding = thread->last_special_binding();
Environment * ext = new Environment(env);
if (varlist != NIL)
{
for (unsigned long i = length(varlist); i-- > 0;)
{
Value obj = car(varlist);
varlist = xcdr(varlist);
if (consp(obj) && length(obj) == 2)
{
Value name = xcar(obj);
Symbol * sym = check_symbol(name);
if (sym->is_special_variable() || env->is_declared_special(name))
{
String * s = new String("Attempt to bind the special variable ");
s->append(::prin1_to_string(name));
s->append(" with SYMBOL-MACROLET.");
return signal_lisp_error(new ProgramError(s));
}
ext->bind(name, make_value(new SymbolMacro(xcar(xcdr(obj)))));
}
else
{
String * s = new String("Malformed symbol-expansion pair in SYMBOL-MACROLET: ");
s->append(::prin1_to_string(obj));
return signal_lisp_error(new ProgramError(s));
}
}
}
Value body = xcdr(args);
// Process declarations.
Value specials = NIL;
while (body != NIL)
{
Value obj = car(body);
if (consp(obj) && xcar(obj) == S_declare)
{
Value decls = xcdr(obj);
while (decls != NIL)
{
Value decl = car(decls);
if (consp(decl) && xcar(decl) == S_special)
{
Value vars = xcdr(decl);
while (vars != NIL)
{
Value name = car(vars);
// "If declaration contains a special declaration that
// names one of the symbols being bound by SYMBOL-MACROLET,
// an error of type PROGRAM-ERROR is signaled."
Value list = xcar(args);
while (list != NIL)
{
if (xcar(xcar(list)) == name)
{
String * s = new String(::prin1_to_string(name));
s->append(" is a symbol-macro and thus can't be declared special.");
return signal_lisp_error(new ProgramError(s));
}
list = xcdr(list);
}
specials = make_cons(name, specials);
vars = xcdr(vars);
}
}
decls = xcdr(decls);
}
body = xcdr(body);
}
else
break;
}
while (specials != NIL)
{
ext->declare_special(xcar(specials));
specials = xcdr(specials);
}
while (body != NIL)
{
result = eval(car(body), ext, thread);
body = xcdr(body);
}
thread->set_last_special_binding(last_special_binding);
return result;
}
